You may also trans-type your {\f1\fs20 variant} instance into a {\f1\fs20 TDocVariantData record}, and access directly to its internals.\line For instance:
! TDocVariantData(V1).AddValue('comment','Nice guy');
! with TDocVariantData(V1) do             // direct transtyping
!   if Kind=dvObject then                 // direct access to the TDocVariantKind field
!   for i := 0 to Count-1 do              // direct access to the Count: integer field
!     writeln(Names[i],'=',Values[i]);    // direct access to the internal storage arrays
By definition, trans-typing via a {\f1\fs20 TDocVariantData record} is slightly faster than using late-binding.
But you must ensure that the {\f1\fs20 variant} instance is really a {\f1\fs20 TDocVariant} kind of data before transtyping e.g. by calling {\f1\fs20 DocVariantType.IsOfType(aVariant)} or the {\f1\fs20 DocVariantData(aVariant)^} function, which works even for members returned as {\f1\fs20 varByRef} via late binding:
! if DocVariantType.IsOfType(V1) then
! with TDocVariantData(V1) do             // direct transtyping
!   for i := 0 to Count-1 do              // direct access to the Count: integer field
!     writeln(Names[i],'=',Values[i]);    // direct access to the internal storage arrays
!
! writeln(V2.doc); // will write  '{"name":"john","doc":{"one":1,"two":2.5}}'
! if DocVariantType.IsOfType(V2.Doc) then // will be false, since V2.Doc is a varByRef variant
................................................................................
!   writeln('never run');                 // .. so TDocVariantData(V2.doc) will fail
! with DocVariantData(V2.Doc)^ do         // note ^ to de-reference into TDocVariantData
!   for i := 0 to Count-1 do              // direct access the TDocVariantData methods
!     writeln(Names[i],'=',Values[i]);
!  // will write to the console:
!  //  one=1
!  //  two=2.5

You can also allocate directly the {\f1\fs20 TDocVariantData} instance on stack, if you do not need any {\f1\fs20 variant}-oriented access to the object, but just some local storage:
!var Doc1,Doc2: TDocVariantData;
! ...
!  Doc1.Init; // needed for proper initialization
!  assert(Doc1.Kind=dvUndefined);
!  Doc1.AddValue('name','John');        // add some properties
!  Doc1.AddValue('birthyear',1972);

You may also trans-type your {\f1\fs20 variant} instance into a {\f1\fs20 TDocVariantData record}, and access directly to its internals.\line For instance:
! TDocVariantData(V1).AddValue('comment','Nice guy');
! with TDocVariantData(V1) do             // direct transtyping
!   if Kind=dvObject then                 // direct access to the TDocVariantKind field
!   for i := 0 to Count-1 do              // direct access to the Count: integer field
!     writeln(Names[i],'=',Values[i]);    // direct access to the internal storage arrays
By definition, trans-typing via a {\f1\fs20 TDocVariantData record} is slightly faster than using late-binding.
But you must ensure that the {\f1\fs20 variant} instance is really a {\f1\fs20 TDocVariant} kind of data before transtyping e.g. by calling {\f1\fs20 DocVariantType.IsOfType(aVariant)} or the {\f1\fs20 DocVariantData(aVariant)^} or {\f1\fs20 DocVariantDataSafe(aVariant)^} functions, which both will work even for members returned as {\f1\fs20 varByRef} via late binding (e.g. {\f1\fs20 V2.doc}):
! if DocVariantType.IsOfType(V1) then
! with TDocVariantData(V1) do             // direct transtyping
!   for i := 0 to Count-1 do              // direct access to the Count: integer field
!     writeln(Names[i],'=',Values[i]);    // direct access to the internal storage arrays
!
! writeln(V2.doc); // will write  '{"name":"john","doc":{"one":1,"two":2.5}}'
! if DocVariantType.IsOfType(V2.Doc) then // will be false, since V2.Doc is a varByRef variant
................................................................................
!   writeln('never run');                 // .. so TDocVariantData(V2.doc) will fail
! with DocVariantData(V2.Doc)^ do         // note ^ to de-reference into TDocVariantData
!   for i := 0 to Count-1 do              // direct access the TDocVariantData methods
!     writeln(Names[i],'=',Values[i]);
!  // will write to the console:
!  //  one=1
!  //  two=2.5
In practice, {\f1\fs20 DocVariantDataSafe(aVariant)^} may be preferred, since {\f1\fs20 DocVariantData(aVariant)^} would raise an {\f1\fs20 EDocVariant} exception if {\f1\fs20 aVariant} is not a {\f1\fs20 TDocVariant}, but {\f1\fs20 DocVariantDataSafe(aVariant)^} would return a "fake" void {\f1\fs20 DocVariant} instance, in which {\f1\fs20 Count=0} and {\f1\fs20 Kind=dbUndefined}.
You can also allocate directly the {\f1\fs20 TDocVariantData} instance on stack, if you do not need any {\f1\fs20 variant}-oriented access to the object, but just some local storage:
!var Doc1,Doc2: TDocVariantData;
! ...
!  Doc1.Init; // needed for proper initialization
!  assert(Doc1.Kind=dvUndefined);
!  Doc1.AddValue('name','John');        // add some properties
!  Doc1.AddValue('birthyear',1972);

}

program Project01;

uses
  Forms,
  SysUtils,

  mORMot,
  Unit1 in 'Unit1.pas' {Form1},
  SampleData in 'SampleData.pas';

{$R *.res}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Form1.Caption := ' Sample 01 - In Memory ORM';
  Form1.Database := TSQLRestStorageInMemory.Create(TSQLSampleRecord,nil,
    ChangeFileExt(paramstr(0),'.db'));
  Application.Run;
end.

}

program Project01;

uses
  Forms,
  SysUtils,
  SynCommons,
  mORMot,
  Unit1 in 'Unit1.pas' {Form1},
  SampleData in 'SampleData.pas';

{$R *.res}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Form1.Caption := ' Sample 01 - In Memory ORM';
  Form1.Database := TSQLRestStorageInMemory.Create(TSQLSampleRecord,nil,
    ChangeFileExt(ExeVersion.ProgramFileName,'.db'));
  Application.Run;
end.

}
program Project02;

uses
  Forms,
  SysUtils,

  mORMot,
  mORMotSQLite3, SynSQLite3Static,
  Unit1 in '..\01 - In Memory ORM\Unit1.pas' {Form1},
  SampleData in '..\01 - In Memory ORM\SampleData.pas';

{$R *.res}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Form1.Caption := ' Sample 02 - Embedded SQLite3 ORM';
  Form1.Database := TSQLRestServerDB.Create(Form1.Model,
    ChangeFileExt(paramstr(0),'.db3'));
  TSQLRestServerDB(Form1.Database).CreateMissingTables;
  Application.Run;
end.

}
program Project02;

uses
  Forms,
  SysUtils,
  SynCommons,
  mORMot,
  mORMotSQLite3, SynSQLite3Static,
  Unit1 in '..\01 - In Memory ORM\Unit1.pas' {Form1},
  SampleData in '..\01 - In Memory ORM\SampleData.pas';

{$R *.res}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Form1.Caption := ' Sample 02 - Embedded SQLite3 ORM';
  Form1.Database := TSQLRestServerDB.Create(Form1.Model,
    ChangeFileExt(ExeVersion.ProgramFileName,'.db3'));
  TSQLRestServerDB(Form1.Database).CreateMissingTables;
  Application.Run;
end.

unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, mORMot, mORMotSQLite3, SynSQLite3Static, StdCtrls, SampleData;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Button1: TButton;
    Label2: TLabel;
    procedure Button1Click(Sender: TObject);
................................................................................
begin
  Close;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Model := CreateSampleModel;
  Server := TSQLRestServerDB.Create(Model,ChangeFileExt(paramstr(0),'.db3'));
  Server.CreateMissingTables;
  Server.ExportServerNamedPipe('03');
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Server.Free;

unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,
  SynCommons, mORMot, mORMotSQLite3, SynSQLite3Static, StdCtrls, SampleData;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Button1: TButton;
    Label2: TLabel;
    procedure Button1Click(Sender: TObject);
................................................................................
begin
  Close;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Model := CreateSampleModel;
  Server := TSQLRestServerDB.Create(Model,ChangeFileExt(ExeVersion.ProgramFileName,'.db3'));
  Server.CreateMissingTables;
  Server.ExportServerNamedPipe('03');
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Server.Free;

begin
  Close;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Model := CreateSampleModel;
  DB := TSQLRestServerDB.Create(Model,ChangeFileExt(paramstr(0),'.db3'),true);
  DB.CreateMissingTables;
  Server := TSQLHttpServer.Create('8080',[DB],'+',HTTP_DEFAULT_MODE);
  Server.AccessControlAllowOrigin := '*'; // allow cross-site AJAX queries
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin

begin
  Close;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Model := CreateSampleModel;
  DB := TSQLRestServerDB.Create(Model,ChangeFileExt(ExeVersion.ProgramFileName,'.db3'),true);
  DB.CreateMissingTables;
  Server := TSQLHttpServer.Create('8080',[DB],'+',HTTP_DEFAULT_MODE);
  Server.AccessControlAllowOrigin := '*'; // allow cross-site AJAX queries
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin

begin
  Close;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Model := CreateSampleModel;
  DB := TSQLRestServerDB.Create(Model,ChangeFileExt(paramstr(0),'.db3'),true);
  DB.CreateMissingTables;
  Server := TCustomHttpServer.Create('8080',[DB],'+',useHttpApiRegisteringURI,32,secNone,'static');
  Server.AccessControlAllowOrigin := '*'; // allow cross-site AJAX queries
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
................................................................................

function TCustomHttpServer.Request(Ctxt: THttpServerRequest): cardinal;
var FileName: TFileName;
begin
  if (Ctxt.Method='GET') and IdemPChar(pointer(Ctxt.URL),'/STATIC/') and
     (PosEx('..',Ctxt.URL)=0) then begin
    // http.sys will send the specified file from kernel mode
    FileName := ExtractFilePath(ParamStr(0))+'www\'+UTF8ToString(Copy(Ctxt.URL,8,maxInt));
    Ctxt.OutContent := StringToUTF8(FileName);
    Ctxt.OutContentType := HTTP_RESP_STATICFILE;
    result := 200; // THttpApiServer.Execute will return 404 if not found
  end else
    // call the associated TSQLRestServer instance(s)
    result := inherited Request(Ctxt);
end;


end.

begin
  Close;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Model := CreateSampleModel;
  DB := TSQLRestServerDB.Create(Model,ChangeFileExt(ExeVersion.ProgramFileName,'.db3'),true);
  DB.CreateMissingTables;
  Server := TCustomHttpServer.Create('8080',[DB],'+',useHttpApiRegisteringURI,32,secNone,'static');
  Server.AccessControlAllowOrigin := '*'; // allow cross-site AJAX queries
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
................................................................................

function TCustomHttpServer.Request(Ctxt: THttpServerRequest): cardinal;
var FileName: TFileName;
begin
  if (Ctxt.Method='GET') and IdemPChar(pointer(Ctxt.URL),'/STATIC/') and
     (PosEx('..',Ctxt.URL)=0) then begin
    // http.sys will send the specified file from kernel mode
    FileName := ExeVersion.ProgramFilePath+'www\'+UTF8ToString(Copy(Ctxt.URL,8,maxInt));
    Ctxt.OutContent := StringToUTF8(FileName);
    Ctxt.OutContentType := HTTP_RESP_STATICFILE;
    result := 200; // THttpApiServer.Execute will return 404 if not found
  end else
    // call the associated TSQLRestServer instance(s)
    result := inherited Request(Ctxt);
end;


end.

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Math,
  DateUtils,

  SynPDF;

const
  PDFFactor: Single = 72.0 / 2.54;

var
  obPDF: TPdfDocument;
................................................................................
  obPDF.Canvas.TextOut(2.0*PDFFactor,27.0*PDFFactor,'XObject form canvas sample');

  obPDF.Canvas.DrawXObject(2.0*PDFFactor,5.0*PDFFactor,1.0,1.0,'FORMOBJECT');
  obPDF.Canvas.DrawXObject(10.0*PDFFactor,10.0*PDFFactor,1.0,0.5,'FORMOBJECT');
  obPDF.Canvas.DrawXObject(8.0*PDFFactor,15.0*PDFFactor,2.0,2.0,'FORMOBJECT');
  obPDF.Canvas.DrawXObject(2.0*PDFFactor,20.0*PDFFactor,0.5,1.0,'FORMOBJECT');

  obPDF.SaveToFile(ChangeFileExt(ParamStr(0),'.pdf'));

  FreeAndNil(obPDF);
end.

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Math,
  DateUtils,
  SynCommons,
  SynPDF;

const
  PDFFactor: Single = 72.0 / 2.54;

var
  obPDF: TPdfDocument;
................................................................................
  obPDF.Canvas.TextOut(2.0*PDFFactor,27.0*PDFFactor,'XObject form canvas sample');

  obPDF.Canvas.DrawXObject(2.0*PDFFactor,5.0*PDFFactor,1.0,1.0,'FORMOBJECT');
  obPDF.Canvas.DrawXObject(10.0*PDFFactor,10.0*PDFFactor,1.0,0.5,'FORMOBJECT');
  obPDF.Canvas.DrawXObject(8.0*PDFFactor,15.0*PDFFactor,2.0,2.0,'FORMOBJECT');
  obPDF.Canvas.DrawXObject(2.0*PDFFactor,20.0*PDFFactor,0.5,1.0,'FORMOBJECT');

  obPDF.SaveToFile(ChangeFileExt(ExeVersion.ProgramFileName,'.pdf'));

  FreeAndNil(obPDF);
end.

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Math,
  DateUtils,

  SynPDF;

const
  PDFFactor: Single = 72.0 / 2.54;

var
  obPDF: TPdfDocument;
................................................................................

  obPDF.Canvas.TextOut(2.0*PDFFactor,2.0*PDFFactor,'Main Layer 3:');

  obPDF.Canvas.BeginMarkedContent(obMainLayer3);
  obPDF.Canvas.TextOut(10.0*PDFFactor,2.0*PDFFactor,'Text visible in Main Layer 3');
  obPDF.Canvas.EndMarkedContent;

  obPDF.SaveToFile(ChangeFileExt(ParamStr(0),'.pdf'));

  FreeAndNil(obPDF);
end.

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Math,
  DateUtils,
  SynCommons,
  SynPDF;

const
  PDFFactor: Single = 72.0 / 2.54;

var
  obPDF: TPdfDocument;
................................................................................

  obPDF.Canvas.TextOut(2.0*PDFFactor,2.0*PDFFactor,'Main Layer 3:');

  obPDF.Canvas.BeginMarkedContent(obMainLayer3);
  obPDF.Canvas.TextOut(10.0*PDFFactor,2.0*PDFFactor,'Text visible in Main Layer 3');
  obPDF.Canvas.EndMarkedContent;

  obPDF.SaveToFile(ChangeFileExt(ExeVersion.ProgramFileName,'.pdf'));

  FreeAndNil(obPDF);
end.

      Font.Style := [fsItalic,fsUnderline];
      TextAlign := taRight;
      AddTextToHeaderAt('http://synopse.info',RightMarginPos);
      Font.Style := [];
      AddLineToFooter(false);
      AddPagesToFooterAt(sPageN,RightMarginPos);
      RestoreSavedLayout;
      AddTextToHeader(ExtractFileName(paramstr(0)));
      AddTextToFooter(DateTimeToStr(Now));
      AddLineToHeader(false);
      Font.Size := 12;
      ExportPDFForceJPEGCompression := 0;

{      // test
      WordWrapLeftCols := true;
................................................................................
    begin
      SetFont('Arial',12,[fsBold]);
      TextOut(100,500,'Test');
      MoveTo(100,400);
      LineTo(500,500);
      Stroke;
    end; }
    FN := ChangeFileExt(paramstr(0),'.pdf');
    SaveToFile(FN);
    ShellExecute(Handle,nil,pointer(FN),nil,nil,SW_SHOWNORMAL);
  finally
    Free;
  end;
  Close;
end;

      Font.Style := [fsItalic,fsUnderline];
      TextAlign := taRight;
      AddTextToHeaderAt('http://synopse.info',RightMarginPos);
      Font.Style := [];
      AddLineToFooter(false);
      AddPagesToFooterAt(sPageN,RightMarginPos);
      RestoreSavedLayout;
      AddTextToHeader(ExeVersion.ProgramName);
      AddTextToFooter(DateTimeToStr(Now));
      AddLineToHeader(false);
      Font.Size := 12;
      ExportPDFForceJPEGCompression := 0;

{      // test
      WordWrapLeftCols := true;
................................................................................
    begin
      SetFont('Arial',12,[fsBold]);
      TextOut(100,500,'Test');
      MoveTo(100,400);
      LineTo(500,500);
      Stroke;
    end; }
    FN := ChangeFileExt(ExeVersion.ProgramFileName,'.pdf');
    SaveToFile(FN);
    ShellExecute(Handle,nil,pointer(FN),nil,nil,SW_SHOWNORMAL);
  finally
    Free;
  end;
  Close;
end;

procedure TSQLite3HttpService.DoStart(Sender: TService);
begin
  TSQLLog.Enter(self);
  if Server<>nil then
    DoStop(nil); // should never happen
  Model := CreateSampleModel;
  DB := TSQLRestServerDB.Create(Model,ChangeFileExt(paramstr(0),'.db3'));
  DB.CreateMissingTables;
  Server := TSQLHttpServer.Create('8080',[DB],'+',useHttpApiRegisteringURI);
  TSQLLog.Add.Log(sllInfo,'Server % started by %',[Server.HttpServer,Server]);
end;

procedure TSQLite3HttpService.DoStop(Sender: TService);
begin

procedure TSQLite3HttpService.DoStart(Sender: TService);
begin
  TSQLLog.Enter(self);
  if Server<>nil then
    DoStop(nil); // should never happen
  Model := CreateSampleModel;
  DB := TSQLRestServerDB.Create(Model,ChangeFileExt(ExeVersion.ProgramFileName,'.db3'));
  DB.CreateMissingTables;
  Server := TSQLHttpServer.Create('8080',[DB],'+',useHttpApiRegisteringURI);
  TSQLLog.Add.Log(sllInfo,'Server % started by %',[Server.HttpServer,Server]);
end;

procedure TSQLite3HttpService.DoStop(Sender: TService);
begin

  HTTPSERVICENAME = 'mORMotHttpServerService';
  HTTPSERVICEDISPLAYNAME = 'mORMot Http Server Service';

begin
  TSQLLog.Family.Level := LOG_VERBOSE;
  with TServiceController.CreateOpenService('','',HTTPSERVICENAME) do
  try
    CheckParameters(ExtractFilePath(paramstr(0))+'HttpService.exe',
      HTTPSERVICEDISPLAYNAME);
  finally
    Free;
  end;
  TSQLLog.Add.Log(sllTrace,'Quitting command line');
  with TServiceController.CreateOpenService('','',HTTPSERVICENAME) do
  try
    State; // just to log the service state after handling the /parameters
  finally
    Free;
  end;
end.

  HTTPSERVICENAME = 'mORMotHttpServerService';
  HTTPSERVICEDISPLAYNAME = 'mORMot Http Server Service';

begin
  TSQLLog.Family.Level := LOG_VERBOSE;
  with TServiceController.CreateOpenService('','',HTTPSERVICENAME) do
  try
    CheckParameters(ExeVersion.ProgramFilePath+'HttpService.exe',
      HTTPSERVICEDISPLAYNAME);
  finally
    Free;
  end;
  TSQLLog.Add.Log(sllTrace,'Quitting command line');
  with TServiceController.CreateOpenService('','',HTTPSERVICENAME) do
  try
    State; // just to log the service state after handling the /parameters
  finally
    Free;
  end;
end.

procedure TMainLogView.btnListSaveClick(Sender: TObject);
begin
  dlgSaveList.FileName := 'Remote '+Utf8ToString(DateTimeToIso8601(Now,false,' '));
  if not dlgSaveList.Execute then
    exit;
  fLog.SaveToFile('temp~.log',
    StringToUTF8(paramstr(0))+' 0.0.0.0 ('+NowToString+')'#13+
    'Host=Remote User=Unknown CPU=Unknown OS=0.0=0.0.0 Wow64=0 Freq=1'#13+
    'LogView '+SYNOPSE_FRAMEWORK_VERSION+' Remote '+NowToString+#13#13);
  if dlgSaveList.FilterIndex=3 then
    FileSynLZ('temp~.log',dlgSaveList.FileName,LOG_MAGIC) else
    RenameFile('temp~.log',dlgSaveList.FileName);
end;

end.

procedure TMainLogView.btnListSaveClick(Sender: TObject);
begin
  dlgSaveList.FileName := 'Remote '+Utf8ToString(DateTimeToIso8601(Now,false,' '));
  if not dlgSaveList.Execute then
    exit;
  fLog.SaveToFile('temp~.log',
    StringToUTF8(ExeVersion.ProgramFileName)+' 0.0.0.0 ('+NowToString+')'#13+
    'Host=Remote User=Unknown CPU=Unknown OS=0.0=0.0.0 Wow64=0 Freq=1'#13+
    'LogView '+SYNOPSE_FRAMEWORK_VERSION+' Remote '+NowToString+#13#13);
  if dlgSaveList.FilterIndex=3 then
    FileSynLZ('temp~.log',dlgSaveList.FileName,LOG_MAGIC) else
    RenameFile('temp~.log',dlgSaveList.FileName);
end;

end.

  end;
end;

constructor TDBExplorerFrame.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  fHint := THintWindowDelayed.Create(self);
  fSQLLogFile := ChangeFileExt(paramstr(0),'.history');
  PagesLeft.ActivePageIndex := 0;
end;

destructor TDBExplorerFrame.Destroy;
begin
  FreeAndNil(fGrid);
  inherited;
................................................................................
            Rep.DrawText(GetTableDescription(TableName));
            Rep.NewLine;
          end;
          Rep.WordWrapLeftCols := true;
          TSQLRibbon(nil).AddToReport(Rep,fGrid.Table,[]);
          Rep.EndDoc;
          Rep.Caption := GetFileNameWithoutExt(ExtractFileName(FileName));
          ExeVersionRetrieve;
          Rep.ExportPDFAuthor := U2S(ExeVersion.User);
          Rep.ExportPDFApplication := Form.Caption;
          Rep.ExportPDFSubject := BtnResultToFile.Hint;
          Rep.ExportPDFKeywords := MemoSQL.Text;
          Rep.ExportPDF(FileName,True,false)
        finally
          Rep.Free;

  end;
end;

constructor TDBExplorerFrame.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  fHint := THintWindowDelayed.Create(self);
  fSQLLogFile := ChangeFileExt(ExeVersion.ProgramFileName,'.history');
  PagesLeft.ActivePageIndex := 0;
end;

destructor TDBExplorerFrame.Destroy;
begin
  FreeAndNil(fGrid);
  inherited;
................................................................................
            Rep.DrawText(GetTableDescription(TableName));
            Rep.NewLine;
          end;
          Rep.WordWrapLeftCols := true;
          TSQLRibbon(nil).AddToReport(Rep,fGrid.Table,[]);
          Rep.EndDoc;
          Rep.Caption := GetFileNameWithoutExt(ExtractFileName(FileName));

          Rep.ExportPDFAuthor := U2S(ExeVersion.User);
          Rep.ExportPDFApplication := Form.Caption;
          Rep.ExportPDFSubject := BtnResultToFile.Hint;
          Rep.ExportPDFKeywords := MemoSQL.Text;
          Rep.ExportPDF(FileName,True,false)
        finally
          Rep.Free;

      C.Server := C.Ident;
      TryConnect(C,True);
    finally
      C.Free;
    end;
  end else begin
    Conns := TSQLRestStorageInMemory.Create(
      TSQLConnection,nil,ChangeFileExt(paramstr(0),'.config'),false);
    try
      Conns.ExpandedJSON := true; // for better human reading and modification
      Task.Title := MainCaption;
      Task.Inst := sSelectAConnection;
      Task.Content := sSelectOrCreateAConnection;
      if Conns.Count=0 then
        Btns := [cbCancel] else begin

      C.Server := C.Ident;
      TryConnect(C,True);
    finally
      C.Free;
    end;
  end else begin
    Conns := TSQLRestStorageInMemory.Create(
      TSQLConnection,nil,ChangeFileExt(ExeVersion.ProgramFileName,'.config'),false);
    try
      Conns.ExpandedJSON := true; // for better human reading and modification
      Task.Title := MainCaption;
      Task.Inst := sSelectAConnection;
      Task.Content := sSelectOrCreateAConnection;
      if Conns.Count=0 then
        Btns := [cbCancel] else begin

begin
  with TSQLLog.Family do begin
    Level := LOG_VERBOSE;
    EchoToConsole := LOG_VERBOSE; // log all events to the console
  end;
  aModel := TSQLModel.Create([],ROOT_NAME);
  try
    with TSQLRestServerDB.Create(aModel,ChangeFileExt(paramstr(0),'.db'),true) do
    try
      CreateMissingTables; // we need AuthGroup and AuthUser tables
      ServiceDefine(TServiceCalculator,[ICalculator],sicShared);
      if ExportServerNamedPipe(APPLICATION_NAME) then
        writeln('Background server is running.'#10) else
        writeln('Error launching the server'#10);
      write('Press [Enter] to close the server.');

begin
  with TSQLLog.Family do begin
    Level := LOG_VERBOSE;
    EchoToConsole := LOG_VERBOSE; // log all events to the console
  end;
  aModel := TSQLModel.Create([],ROOT_NAME);
  try
    with TSQLRestServerDB.Create(aModel,ChangeFileExt(ExeVersion.ProgramFileName,'.db'),true) do
    try
      CreateMissingTables; // we need AuthGroup and AuthUser tables
      ServiceDefine(TServiceCalculator,[ICalculator],sicShared);
      if ExportServerNamedPipe(APPLICATION_NAME) then
        writeln('Background server is running.'#10) else
        writeln('Error launching the server'#10);
      write('Press [Enter] to close the server.');

end;

var
  aModel: TSQLModel;
  aProps: TSQLDBSQLite3ConnectionProperties;
begin
  aProps := TSQLDBSQLite3ConnectionProperties.Create(
    StringToUtf8(ChangeFileExt(paramstr(0),'.db')),'','','');
  try
    aModel := TSQLModel.Create([TSQLAuthGroup,TSQLAuthUser],ROOT_NAME);
    VirtualTableExternalRegisterAll(aModel,aProps);
    try
      with TSQLRestServerDB.Create(aModel,SQLITE_MEMORY_DATABASE_NAME,true) do
      try
        CreateMissingTables; // we need AuthGroup and AuthUser tables

end;

var
  aModel: TSQLModel;
  aProps: TSQLDBSQLite3ConnectionProperties;
begin
  aProps := TSQLDBSQLite3ConnectionProperties.Create(
    StringToUtf8(ChangeFileExt(ExeVersion.ProgramFileName,'.db')),'','','');
  try
    aModel := TSQLModel.Create([TSQLAuthGroup,TSQLAuthUser],ROOT_NAME);
    VirtualTableExternalRegisterAll(aModel,aProps);
    try
      with TSQLRestServerDB.Create(aModel,SQLITE_MEMORY_DATABASE_NAME,true) do
      try
        CreateMissingTables; // we need AuthGroup and AuthUser tables

    property ReadAllDirectTime: RawUTF8 read fReadAllDirectTime;
    property ReadAllDirectRate: integer read fReadAllDirectRate;
    property ClientCloseTime: RawUTF8 read fClientCloseTime;
  end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  Ini := StringFromFile(ChangeFileExt(paramstr(0),'.ini'));
  OraTNSName.Text := UTF8ToString(FindIniEntry(Ini,'Oracle','TNSName'));
  OraUser.Text := UTF8ToString(FindIniEntry(Ini,'Oracle','User'));
  OraPass.Text := UTF8ToString(FindIniEntry(Ini,'Oracle','Password'));
  Stats := TObjectList.Create;
end;

const
................................................................................
  FIREBIRD_LIB = 'Firebird'+{$ifdef CPU64}'64'+{$endif=}'\fbembed.dll';

procedure TMainForm.BtnRunTestsClick(Sender: TObject);
var T,U,P: RawUTF8;
    props: TSQLDBSQLite3ConnectionProperties;
    server: TSQLDBServerAbstract;
begin
  ExeVersionRetrieve;
  //SynDBLog.Family.Level := LOG_VERBOSE;  // for debugging
  T := StringToUTF8(OraTNSName.Text);
  U := StringToUTF8(OraUser.Text);
  P := StringToUTF8(OraPass.Text);
  UpdateIniEntry(Ini,'Oracle','TNSName',T);
  UpdateIniEntry(Ini,'Oracle','User',U);
  UpdateIniEntry(Ini,'Oracle','Password',P);
  FileFromString(Ini,ChangeFileExt(paramstr(0),'.ini'));
  LogMemo.Clear;
{  FreeAndNil(sqlite3); sqlite3 := TSQLite3LibraryDynamic.Create('sqlite3.dll'); }
  // if false then
  try
  try
    // -------- SQlite3
    //(*
................................................................................
  except
    on E: Exception do
      LogMemo.Lines.Add(E.Message);
  end;
  finally
    Label3.Caption := '';
    T := ObjectToJSON(Stats,[woHumanReadable]);
    FileFromString(T,ChangeFileExt(paramstr(0),'.stats'));
    FileFromString(T,Ansi7ToString(NowToString(false))+'.log');
    SaveStats;
  end;
end;

type
  TSQLRecordSample = class(TSQLRecord)
................................................................................
  for i := 0 to Stats.Count-1 do
    txt := txt+Int32ToUtf8(Stat[i].ReadAllVirtualRate)+',';
  txt[length(txt)] := '|';
  for i := 0 to Stats.Count-1 do
    txt := txt+Int32ToUtf8(Stat[i].ReadAllDirectRate)+',';
  PicEnd(Cat1);

  FileFromString(Doc,ChangeFileExt(paramstr(0),'.txt'));
  FileFromString('<html><body>'#13#10+s,ChangeFileExt(paramstr(0),'.htm'));
end;

procedure TMainForm.FormShow(Sender: TObject);
var Valid: boolean;
    S: RawUTF8;
begin
  btnReport.Visible := DebugHook=0;
................................................................................
    SaveStats;
  Close;
end;


procedure TMainForm.btnReportClick(Sender: TObject);
begin
  ShellExecute(0,'open',pointer(ChangeFileExt(paramstr(0),'.htm')),'','',SW_SHOWMAXIMIZED);
end;

end.

    property ReadAllDirectTime: RawUTF8 read fReadAllDirectTime;
    property ReadAllDirectRate: integer read fReadAllDirectRate;
    property ClientCloseTime: RawUTF8 read fClientCloseTime;
  end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  Ini := StringFromFile(ChangeFileExt(ExeVersion.ProgramFileName,'.ini'));
  OraTNSName.Text := UTF8ToString(FindIniEntry(Ini,'Oracle','TNSName'));
  OraUser.Text := UTF8ToString(FindIniEntry(Ini,'Oracle','User'));
  OraPass.Text := UTF8ToString(FindIniEntry(Ini,'Oracle','Password'));
  Stats := TObjectList.Create;
end;

const
................................................................................
  FIREBIRD_LIB = 'Firebird'+{$ifdef CPU64}'64'+{$endif=}'\fbembed.dll';

procedure TMainForm.BtnRunTestsClick(Sender: TObject);
var T,U,P: RawUTF8;
    props: TSQLDBSQLite3ConnectionProperties;
    server: TSQLDBServerAbstract;
begin

  //SynDBLog.Family.Level := LOG_VERBOSE;  // for debugging
  T := StringToUTF8(OraTNSName.Text);
  U := StringToUTF8(OraUser.Text);
  P := StringToUTF8(OraPass.Text);
  UpdateIniEntry(Ini,'Oracle','TNSName',T);
  UpdateIniEntry(Ini,'Oracle','User',U);
  UpdateIniEntry(Ini,'Oracle','Password',P);
  FileFromString(Ini,ChangeFileExt(ExeVersion.ProgramFileName,'.ini'));
  LogMemo.Clear;
{  FreeAndNil(sqlite3); sqlite3 := TSQLite3LibraryDynamic.Create('sqlite3.dll'); }
  // if false then
  try
  try
    // -------- SQlite3
    //(*
................................................................................
  except
    on E: Exception do
      LogMemo.Lines.Add(E.Message);
  end;
  finally
    Label3.Caption := '';
    T := ObjectToJSON(Stats,[woHumanReadable]);
    FileFromString(T,ChangeFileExt(ExeVersion.ProgramFileName,'.stats'));
    FileFromString(T,Ansi7ToString(NowToString(false))+'.log');
    SaveStats;
  end;
end;

type
  TSQLRecordSample = class(TSQLRecord)
................................................................................
  for i := 0 to Stats.Count-1 do
    txt := txt+Int32ToUtf8(Stat[i].ReadAllVirtualRate)+',';
  txt[length(txt)] := '|';
  for i := 0 to Stats.Count-1 do
    txt := txt+Int32ToUtf8(Stat[i].ReadAllDirectRate)+',';
  PicEnd(Cat1);

  FileFromString(Doc,ChangeFileExt(ExeVersion.ProgramFileName,'.txt'));
  FileFromString('<html><body>'#13#10+s,ChangeFileExt(ExeVersion.ProgramFileName,'.htm'));
end;

procedure TMainForm.FormShow(Sender: TObject);
var Valid: boolean;
    S: RawUTF8;
begin
  btnReport.Visible := DebugHook=0;
................................................................................
    SaveStats;
  Close;
end;


procedure TMainForm.btnReportClick(Sender: TObject);
begin
  ShellExecute(0,'open',pointer(ChangeFileExt(ExeVersion.ProgramFileName,'.htm')),'','',SW_SHOWMAXIMIZED);
end;

end.

  fSettings.Free;
end;

procedure TMainForm.FormShow(Sender: TObject);
begin
  PTypeInfo(TypeInfo(TRemoteSQLEngine))^.EnumBaseType^.AddCaptionStrings(cbbEngine.Items);
  fSettings := TProjectSettings.Create;
  fSettingsFileName := ChangeFileExt(paramstr(0),'.settings');
  JSONFileToObject(fSettingsFileName,fSettings);
  cbbEngine.ItemIndex := ord(fSettings.fEngine);
  lbledtServer.Text := UTF8ToString(fSettings.fServerName);
  lbledtDatabase.Text := UTF8ToString(fSettings.fDatabaseName);
  lbledtUser.Text := UTF8ToString(fSettings.fUserID);
  lbledtPassword.Text := UTF8ToString(fSettings.fPassword);
  fModel := TSQLModel.Create([],ROOT_NAME);

  fSettings.Free;
end;

procedure TMainForm.FormShow(Sender: TObject);
begin
  PTypeInfo(TypeInfo(TRemoteSQLEngine))^.EnumBaseType^.AddCaptionStrings(cbbEngine.Items);
  fSettings := TProjectSettings.Create;
  fSettingsFileName := ChangeFileExt(ExeVersion.ProgramFileName,'.settings');
  JSONFileToObject(fSettingsFileName,fSettings);
  cbbEngine.ItemIndex := ord(fSettings.fEngine);
  lbledtServer.Text := UTF8ToString(fSettings.fServerName);
  lbledtDatabase.Text := UTF8ToString(fSettings.fDatabaseName);
  lbledtUser.Text := UTF8ToString(fSettings.fUserID);
  lbledtPassword.Text := UTF8ToString(fSettings.fPassword);
  fModel := TSQLModel.Create([],ROOT_NAME);

    Level := LOG_STACKTRACE;
    EchoToConsole := LOG_VERBOSE; // events to the console
    PerThreadLog := ptIdentifiedInOnFile;
  end;
  // create a Data Model
  aModel := TSQLModel.Create([TSQLRecordPeople]);
  try
    aDatabaseFile := ChangeFileExt(paramstr(0),'.db3');
    DeleteFile(aDatabaseFile);
    aServer := TSQLRestServerDB.Create(aModel,aDatabaseFile);
    try
      aServer.AcquireWriteTimeOut := 15000;   // 15 seconds before write failure
      aServer.DB.Synchronous := smOff;
      aServer.DB.LockingMode := lmExclusive;  // off+exclusive = fastest SQLite3  
      aServer.NoAJAXJSON := true;

    Level := LOG_STACKTRACE;
    EchoToConsole := LOG_VERBOSE; // events to the console
    PerThreadLog := ptIdentifiedInOnFile;
  end;
  // create a Data Model
  aModel := TSQLModel.Create([TSQLRecordPeople]);
  try
    aDatabaseFile := ChangeFileExt(ExeVersion.ProgramFileName,'.db3');
    DeleteFile(aDatabaseFile);
    aServer := TSQLRestServerDB.Create(aModel,aDatabaseFile);
    try
      aServer.AcquireWriteTimeOut := 15000;   // 15 seconds before write failure
      aServer.DB.Synchronous := smOff;
      aServer.DB.LockingMode := lmExclusive;  // off+exclusive = fastest SQLite3  
      aServer.NoAJAXJSON := true;

  end;


{ TTestServer }

constructor TTestServer.Create(const Path: TFileName);
begin
  ExeVersionRetrieve; 
  fServer := THttpApiServer.Create(false);
  fSMManager := TSMEngineManager.Create;
  fSMManager.OnNewEngine := DoOnNewEngine;
  fShowDownLib := AnyTextFileToSynUnicode(ExeVersion.ProgramFilePath+'showdown.js');
  fServer.AddUrl('root','888',false,'+',true);
  fServer.RegisterCompress(CompressDeflate); // our server will deflate html :)
  fServer.OnRequest := Process;
................................................................................
      // THttpApiServer.Execute will return 404 if not found
    end;
    result := 200;
  end;
end;

begin
  with TTestServer.Create(ExtractFilePath(ParamStr(0))) do
  try
    write('Server is now running on http://localhost:888/root'#13#10#13#10+
      'Press [Enter] to quit');
    readln;
  finally
    Free;
  end;
  
{$endif WIN64}
end.

  end;


{ TTestServer }

constructor TTestServer.Create(const Path: TFileName);
begin

  fServer := THttpApiServer.Create(false);
  fSMManager := TSMEngineManager.Create;
  fSMManager.OnNewEngine := DoOnNewEngine;
  fShowDownLib := AnyTextFileToSynUnicode(ExeVersion.ProgramFilePath+'showdown.js');
  fServer.AddUrl('root','888',false,'+',true);
  fServer.RegisterCompress(CompressDeflate); // our server will deflate html :)
  fServer.OnRequest := Process;
................................................................................
      // THttpApiServer.Execute will return 404 if not found
    end;
    result := 200;
  end;
end;

begin
  with TTestServer.Create(ExeVersion.ProgramFilePath) do
  try
    write('Server is now running on http://localhost:888/root'#13#10#13#10+
      'Press [Enter] to quit');
    readln;
  finally
    Free;
  end;
  
{$endif WIN64}
end.

  ansiScriptStrConcatUndefPlusNum: AnsiString = '''fuck me tender '' + (undefined + 1)';
var
  scrObj: PJSScript;
  rval: jsval;
//  fn: AnsiString;
  uString: SynUnicode;
begin
  scriptDir := ExtractFilePath(ParamStr(0)) + 'js';
  Check(DirectoryExists(scriptDir), scriptDir + ' dose not exist');
  if CheckFailed(IsAnsiCompatible(PChar(scriptDir)), ' Path to test directory must be Ansi Compatible') then Exit;

  // check global accessible from script
  Check( JS_EvaluateScript(cx, global, PCChar(globalAccess), length(globalAccess), 'test', 1, rval) = JS_TRUE, 'direct assign global.var');

  // check error, which was in SM17
................................................................................
  engine: TSMEngine;
  mSource: SynUnicode;
  mustacheFN: TFileName;
  mustache: RawByteString;
  i: integer;
begin
  engine := FManager.ThreadSafeEngine;
  mustacheFN := ExtractFilePath(ParamStr(0)) + 'js\mustache.js';
  mSource := AnyTextFileToSynUnicode(mustacheFN);
  if mSource='' then begin
    mustache := TWinINet.Get('https://github.com/janl/mustache.js/raw/master/mustache.js');
    if PosEx('return send(result);',mustache)=0 then begin
      i := PosEx('send(result);',mustache);
      if i>0 then
        insert('return ',mustache,i); // fix syntax error in official libary! :)
................................................................................
  mSource: SynUnicode;
  inArr: SMValArray;
  outv: TSMValue;
  i: Integer;
  resultFromFortunes, rendered: RawUTF8; // n frtune test here must be resultFromFortunes of database query
begin
  engine := FManager.ThreadSafeEngine;
  mSource := AnyTextFileToSynUnicode(ExtractFilePath(ParamStr(0)) + 'js\precompiledMustache.js');
  if mSource='' then
    exit;
  CheckFailed(mSource <> '', 'exist js\precompiledMustache.js');
  engine.Evaluate(mSource, 'precompiledMustache.js');
  setLength(inArr, 1);
  for i := 0 to 1000 do begin
    resultFromFortunes := FormatUTF8('[{"id": %, "message": "message%"},{"id": %, "message": "message%"}]', [i, i, i+1, i+1]);

  ansiScriptStrConcatUndefPlusNum: AnsiString = '''fuck me tender '' + (undefined + 1)';
var
  scrObj: PJSScript;
  rval: jsval;
//  fn: AnsiString;
  uString: SynUnicode;
begin
  scriptDir := ExeVersion.ProgramFilePath + 'js';
  Check(DirectoryExists(scriptDir), scriptDir + ' dose not exist');
  if CheckFailed(IsAnsiCompatible(PChar(scriptDir)), ' Path to test directory must be Ansi Compatible') then Exit;

  // check global accessible from script
  Check( JS_EvaluateScript(cx, global, PCChar(globalAccess), length(globalAccess), 'test', 1, rval) = JS_TRUE, 'direct assign global.var');

  // check error, which was in SM17
................................................................................
  engine: TSMEngine;
  mSource: SynUnicode;
  mustacheFN: TFileName;
  mustache: RawByteString;
  i: integer;
begin
  engine := FManager.ThreadSafeEngine;
  mustacheFN := ExeVersion.ProgramFilePath + 'js\mustache.js';
  mSource := AnyTextFileToSynUnicode(mustacheFN);
  if mSource='' then begin
    mustache := TWinINet.Get('https://github.com/janl/mustache.js/raw/master/mustache.js');
    if PosEx('return send(result);',mustache)=0 then begin
      i := PosEx('send(result);',mustache);
      if i>0 then
        insert('return ',mustache,i); // fix syntax error in official libary! :)
................................................................................
  mSource: SynUnicode;
  inArr: SMValArray;
  outv: TSMValue;
  i: Integer;
  resultFromFortunes, rendered: RawUTF8; // n frtune test here must be resultFromFortunes of database query
begin
  engine := FManager.ThreadSafeEngine;
  mSource := AnyTextFileToSynUnicode(ExeVersion.ProgramFilePath + 'js\precompiledMustache.js');
  if mSource='' then
    exit;
  CheckFailed(mSource <> '', 'exist js\precompiledMustache.js');
  engine.Evaluate(mSource, 'precompiledMustache.js');
  setLength(inArr, 1);
  for i := 0 to 1000 do begin
    resultFromFortunes := FormatUTF8('[{"id": %, "message": "message%"},{"id": %, "message": "message%"}]', [i, i, i+1, i+1]);

      result := VariantToUTF8(fEngine.Global.Mustache.render(Template, data, partial));
  end else
  {$endif}
    exit;
  mmoResult.Lines.Text :=
    Format('Rendered %d times in %s (%d/sec):'#13#10#13#10'%s',
      [n,Timer.Stop,Timer.PerSec(n),result]);
  FileFromString(Result,ChangeFileExt(paramstr(0),'.html'));
end;

procedure TMainForm.btnOpenBrowserClick(Sender: TObject);
begin
  ShellExecute(0,'open',Pointer(ChangeFileExt(paramstr(0),'.html')),nil,nil,SW_SHOWNORMAL);
end;

procedure TMainForm.FormShow(Sender: TObject);
{$ifdef CPU64} // SpiderMonkey library is not available yet in 64 bit
begin
  btnExecSpiderMonkey.Hide;
end;
................................................................................
var mustacheFN: TFileName;
    mSource: SynUnicode;
    mustache: RawByteString;
    i: integer;
begin
  fEngineManager := TSMEngineManager.Create;
  fEngine := fEngineManager.ThreadSafeEngine;
  mustacheFN := ExtractFilePath(ParamStr(0)) + 'js\mustache.js';
  mSource := AnyTextFileToSynUnicode(mustacheFN);
  if mSource='' then begin
    mustache := TWinINet.Get('https://github.com/janl/mustache.js/raw/master/mustache.js');
    if PosEx('return send(result);',mustache)=0 then begin
      i := PosEx('send(result);',mustache);
      if i>0 then
        insert('return ',mustache,i); // fix syntax error in official libary! :)

      result := VariantToUTF8(fEngine.Global.Mustache.render(Template, data, partial));
  end else
  {$endif}
    exit;
  mmoResult.Lines.Text :=
    Format('Rendered %d times in %s (%d/sec):'#13#10#13#10'%s',
      [n,Timer.Stop,Timer.PerSec(n),result]);
  FileFromString(Result,ChangeFileExt(ExeVersion.ProgramFileName,'.html'));
end;

procedure TMainForm.btnOpenBrowserClick(Sender: TObject);
begin
  ShellExecute(0,'open',Pointer(ChangeFileExt(ExeVersion.ProgramFileName,'.html')),nil,nil,SW_SHOWNORMAL);
end;

procedure TMainForm.FormShow(Sender: TObject);
{$ifdef CPU64} // SpiderMonkey library is not available yet in 64 bit
begin
  btnExecSpiderMonkey.Hide;
end;
................................................................................
var mustacheFN: TFileName;
    mSource: SynUnicode;
    mustache: RawByteString;
    i: integer;
begin
  fEngineManager := TSMEngineManager.Create;
  fEngine := fEngineManager.ThreadSafeEngine;
  mustacheFN := ExeVersion.ProgramFilePath + 'js\mustache.js';
  mSource := AnyTextFileToSynUnicode(mustacheFN);
  if mSource='' then begin
    mustache := TWinINet.Get('https://github.com/janl/mustache.js/raw/master/mustache.js');
    if PosEx('return send(result);',mustache)=0 then begin
      i := PosEx('send(result);',mustache);
      if i>0 then
        insert('return ',mustache,i); // fix syntax error in official libary! :)

{ TTestBigContentRead }

procedure TTestBigContentRead.DownloadFilesIfNecessary;
var download: RawByteString;
begin // overriden method should have been set fFileName+fZipFileName+fDownloadURI
  fRunConsoleOccurenceNumber := 0;
  fMemoryAtStart := MemoryUsed;
  fFileName := ExtractFilePath(ParamStr(0))+fFileName;
  if not FileExists(fFileName) then begin
    download := TWinINet.Get(fDownloadURI);
    if not CheckFailed(download<>'') then begin
      with TZipRead.Create(pointer(download),length(download)) do
      try
        UnZip(fZipFileName,fFileName,true);
      finally
................................................................................
    property YearOfDeath: word read fYearOfDeath write fYearOfDeath;
  end;

procedure TTestTableContent.DownloadFilesIfNecessary;
var i: integer;
begin
  fMemoryAtStart := MemoryUsed;
  fFileName := ExtractFilePath(paramstr(0));
  i := pos('\Samples\',fFileName);
  if i>0 then begin
    Setlength(fFileName,i);
    if FileExists(fFileName+'exe\people.json') then
      fFileName := fFileName+'exe\people.json' else
      fFileName  := fFileName+'people.json'
  end;

{ TTestBigContentRead }

procedure TTestBigContentRead.DownloadFilesIfNecessary;
var download: RawByteString;
begin // overriden method should have been set fFileName+fZipFileName+fDownloadURI
  fRunConsoleOccurenceNumber := 0;
  fMemoryAtStart := MemoryUsed;
  fFileName := ExeVersion.ProgramFilePath+fFileName;
  if not FileExists(fFileName) then begin
    download := TWinINet.Get(fDownloadURI);
    if not CheckFailed(download<>'') then begin
      with TZipRead.Create(pointer(download),length(download)) do
      try
        UnZip(fZipFileName,fFileName,true);
      finally
................................................................................
    property YearOfDeath: word read fYearOfDeath write fYearOfDeath;
  end;

procedure TTestTableContent.DownloadFilesIfNecessary;
var i: integer;
begin
  fMemoryAtStart := MemoryUsed;
  fFileName := ExeVersion.ProgramFilePath;
  i := pos('\Samples\',fFileName);
  if i>0 then begin
    Setlength(fFileName,i);
    if FileExists(fFileName+'exe\people.json') then
      fFileName := fFileName+'exe\people.json' else
      fFileName  := fFileName+'people.json'
  end;

  mORMotHTTPServer,
  RESTData,
  RESTServerClass in 'RESTServerClass.pas';

var ORMServer: TNoteServer;
    HTTPServer: TSQLHttpServer;
begin
  ORMServer := TNoteServer.Create(ExtractFilePath(paramstr(0))+'data','root');
  try
    HTTPServer := TSQLHttpServer.Create(HTTP_PORT,[ORMServer]);
    try
      AllocConsole;
      TSQLLog.Family.EchoToConsole := LOG_VERBOSE;
      writeln(#13#10'Background server is running at http://localhost:888'#13#10+
              #13#10'Press [Enter] to close the server.');

  mORMotHTTPServer,
  RESTData,
  RESTServerClass in 'RESTServerClass.pas';

var ORMServer: TNoteServer;
    HTTPServer: TSQLHttpServer;
begin
  ORMServer := TNoteServer.Create(ExeVersion.ProgramFilePath+'data','root');
  try
    HTTPServer := TSQLHttpServer.Create(HTTP_PORT,[ORMServer]);
    try
      AllocConsole;
      TSQLLog.Family.EchoToConsole := LOG_VERBOSE;
      writeln(#13#10'Background server is running at http://localhost:888'#13#10+
              #13#10'Press [Enter] to close the server.');

      while P^<>' ' do
        if P^=#0 then
          break else
          inc(P);
      if P^=#0 then
        break;
      inc(P);

      if IdemPChar(P,'HREF=') then
        H := P+5 else
      if IdemPChar(P,'SRC=') then
        H := P+4 else
        continue;
      if H^='"' then inc(H);
      AddNoJSONEscape(B,H-B);
      P := H;
      if P^='/' then
        if IdemPChar(P+1,'POST/') then begin
          GetUrl(P+6);
................................................................................
            inc(P,urlLen+6);
          end else
            AddString(aDotClearRoot);
        end else
        if IdemPChar(P+1,'PUBLIC/') then begin
          if PublicFolder<>'' then begin
            GetUrl(P+8);
            FN := PublicFolder+UTF8ToString(StringReplaceChars(url,'/','\'));
            EnsureDirectoryExists(ExtractFilePath(FN));
            if not FileExists(FN) then

              FileFromString(TWinHTTP.Get(aDotClearRoot+'/public/'+url),FN);
            AddShort('.static');
          end else
            AddString(aDotClearRoot);
        end;
      B := P;
    end;
    AddNoJSONEscape(B);
................................................................................
    SetText(result);
  finally
    Free;
  end;
end;
begin
  if aStaticFolder<>'' then begin
    PublicFolder := IncludeTrailingPathDelimiter(aStaticFolder)+'public\';
    EnsureDirectoryExists(PublicFolder);
  end;
  TAutoFree.Several([
    @data,TDotClearTable.Parse(aFlatFile),
    @urls,TRawUTF8ListHashed.Create,
    @batch,TSQLRestBatch.Create(Rest,TSQLTag,5000)]);
  TSQLRecord.AutoFree([ // avoid several try..finally
................................................................................
  end;
  Rest.BatchSend(batch);
  aTagsLookup.SaveOccurence(Rest);
end;


end.

      while P^<>' ' do
        if P^=#0 then
          break else
          inc(P);
      if P^=#0 then
        break;
      inc(P);
      H := P; // makes compiler happy
      if IdemPChar(P,'HREF=') then
        inc(H,5) else
      if IdemPChar(P,'SRC=') then
        inc(H,4) else
        continue;
      if H^='"' then inc(H);
      AddNoJSONEscape(B,H-B);
      P := H;
      if P^='/' then
        if IdemPChar(P+1,'POST/') then begin
          GetUrl(P+6);
................................................................................
            inc(P,urlLen+6);
          end else
            AddString(aDotClearRoot);
        end else
        if IdemPChar(P+1,'PUBLIC/') then begin
          if PublicFolder<>'' then begin
            GetUrl(P+8);
            FN := PublicFolder+UTF8ToString(StringReplaceChars(url,'/',PathDelim));
            EnsureDirectoryExists(ExtractFilePath(FN));
            if not FileExists(FN) then
              FileFromString({$ifdef MSWINDOWS}TWinHTTP.Get{$else}HttpGet{$endif}(
                aDotClearRoot+'/public/'+url),FN);
            AddShort('.static');
          end else
            AddString(aDotClearRoot);
        end;
      B := P;
    end;
    AddNoJSONEscape(B);
................................................................................
    SetText(result);
  finally
    Free;
  end;
end;
begin
  if aStaticFolder<>'' then begin
    PublicFolder := IncludeTrailingPathDelimiter(aStaticFolder)+'public'+PathDelim;
    EnsureDirectoryExists(PublicFolder);
  end;
  TAutoFree.Several([
    @data,TDotClearTable.Parse(aFlatFile),
    @urls,TRawUTF8ListHashed.Create,
    @batch,TSQLRestBatch.Create(Rest,TSQLTag,5000)]);
  TSQLRecord.AutoFree([ // avoid several try..finally
................................................................................
  end;
  Rest.BatchSend(batch);
  aTagsLookup.SaveOccurence(Rest);
end;


end.

var aModel: TSQLModel;
    aServer: TSQLRestServerDB;
    aApplication: TBlogApplication;
    aHTTPServer: TSQLHttpServer;
begin
  aModel := CreateModel;
  try
    aServer := TSQLRestServerDB.Create(aModel,ChangeFileExt(paramstr(0),'.db'));
    try
      aServer.DB.Synchronous := smNormal;
      aServer.DB.LockingMode := lmExclusive;
      aServer.CreateMissingTables;
      aApplication := TBlogApplication.Create;
      try
        aApplication.Start(aServer);

var aModel: TSQLModel;
    aServer: TSQLRestServerDB;
    aApplication: TBlogApplication;
    aHTTPServer: TSQLHttpServer;
begin
  aModel := CreateModel;
  try
    aServer := TSQLRestServerDB.Create(aModel,ChangeFileExt(ExeVersion.ProgramFileName,'.db'));
    try
      aServer.DB.Synchronous := smNormal;
      aServer.DB.LockingMode := lmExclusive;
      aServer.CreateMissingTables;
      aApplication := TBlogApplication.Create;
      try
        aApplication.Start(aServer);

      fTempAuditTrail.StatusMessage := T.RecordProps.SQLTableName+'  '+tmp;
    end;
  Add(fTempAuditTrail,true);
end;

constructor TFileServer.Create;
begin
  inherited Create(CreateFileModel(self),ChangeFileExt(paramstr(0),'.db3'));
  CreateMissingTables(ExeVersion.Version.Version32);
  Server := TSQLHttpServer.Create(SERVER_HTTP_PORT,self,'+',useHttpApiRegisteringURI);
  AddAuditTrail(feServerStarted);
  OnUpdateEvent := OnDatabaseUpdateEvent;
end;

destructor TFileServer.Destroy;

      fTempAuditTrail.StatusMessage := T.RecordProps.SQLTableName+'  '+tmp;
    end;
  Add(fTempAuditTrail,true);
end;

constructor TFileServer.Create;
begin
  inherited Create(CreateFileModel(self),ChangeFileExt(ExeVersion.ProgramFileName,'.db3'));
  CreateMissingTables(ExeVersion.Version.Version32);
  Server := TSQLHttpServer.Create(SERVER_HTTP_PORT,self,'+',useHttpApiRegisteringURI);
  AddAuditTrail(feServerStarted);
  OnUpdateEvent := OnDatabaseUpdateEvent;
end;

destructor TFileServer.Destroy;

function CreateFileModel(Owner: TSQLRest): TSQLModel;
begin
  result := TSQLModel.Create(Owner,
    @FileTabs,length(FileTabs),sizeof(FileTabs[0]),[],
    TypeInfo(TFileAction),TypeInfo(TFileEvent));
end;


initialization
  ExeVersionRetrieve(3);

end.

function CreateFileModel(Owner: TSQLRest): TSQLModel;
begin
  result := TSQLModel.Create(Owner,
    @FileTabs,length(FileTabs),sizeof(FileTabs[0]),[],
    TypeInfo(TFileAction),TypeInfo(TFileEvent));
end;


initialization

  SetExecutableVersion(3,0,0);
end.

    //Props.ConnectionStringDialogExecute;
    Conn := Props.NewConnection;
    try
      Conn.Connect; // optional
      Query := Conn.NewStatement;
      try
        Query.Execute('select * from Sales.Customer where AccountNumber like ?',true,['AW000001%']);
        F := TFileStream.Create(ChangeFileExt(paramstr(0),'.json'),fmCreate);
        try
          Query.FetchAllToJSON(F,false);
        finally
          F.Free;
        end;
      finally
        Query.Free;

    //Props.ConnectionStringDialogExecute;
    Conn := Props.NewConnection;
    try
      Conn.Connect; // optional
      Query := Conn.NewStatement;
      try
        Query.Execute('select * from Sales.Customer where AccountNumber like ?',true,['AW000001%']);
        F := TFileStream.Create(ChangeFileExt(ExeVersion.ProgramFileName,'.json'),fmCreate);
        try
          Query.FetchAllToJSON(F,false);
        finally
          F.Free;
        end;
      finally
        Query.Free;

  {$ifdef ISDELPHI2007ANDUP}
  {$ifdef DEBUG}
  ReportMemoryLeaksOnShutdown := True;
  {$endif}
  {$endif}
  SQLite3ConsoleTests;
  {$ifdef COMPUTEFPCINTERFACES}
  ChDir(ExtractFilePath(ParamStr(0)));
  ComputeFPCInterfacesUnit(
    ['..\CrossPlatform\templates','..\..\CrossPlatform\templates'],
     '\..\..\SQlite3\TestSQL3FPCInterfaces.pas');
  {$endif}
end.

  {$ifdef ISDELPHI2007ANDUP}
  {$ifdef DEBUG}
  ReportMemoryLeaksOnShutdown := True;
  {$endif}
  {$endif}
  SQLite3ConsoleTests;
  {$ifdef COMPUTEFPCINTERFACES}
  ChDir(ExeVersion.ProgramFilePath);
  ComputeFPCInterfacesUnit(
    ['..\CrossPlatform\templates','..\..\CrossPlatform\templates'],
     '\..\..\SQlite3\TestSQL3FPCInterfaces.pas');
  {$endif}
end.

  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 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 
................................................................................
  fInputCookieLastName := ''; // cache reset
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,'/','\'));
end;

procedure TSQLRestServerURIContext.Returns(const Result: RawUTF8;
  Status: integer; const CustomHeader: RawUTF8;
  Handle304NotModified,HandleErrorAsRegularResult: boolean);
var clientHash, serverHash: RawUTF8;
begin
................................................................................
  const Error404Redirect: RawUTF8);
var fileName: TFileName;
begin
  if URIBlobFieldName='' then
    fileName := DefaultFileName else
    if PosEx('..',URIBlobFieldName)>0 then
      fileName := '' else
      fileName := UTF8ToString(StringReplaceChars(URIBlobFieldName,'/','\'));
  if fileName<>'' then
    fileName := IncludeTrailingPathDelimiter(FolderName)+fileName;
  ReturnFile(fileName,Handle304NotModified,'','',Error404Redirect);
end;

procedure TSQLRestServerURIContext.Redirect(const NewLocation: RawUTF8;
  PermanentChange: boolean);
................................................................................
    fFeatures.FileExtension := UTF8ToString(LowerCase(fModuleName));
end;

function TSQLVirtualTableModule.FileName(const aTableName: RawUTF8): TFileName;
begin
  result := UTF8ToString(aTableName)+'.'+FileExtension;;
  if fFilePath='' then
    result := ExtractFilePath(paramstr(0))+result else
    result := IncludeTrailingPathDelimiter(fFilePath)+result;
end;


{ TSQLVirtualTable }

constructor TSQLVirtualTable.Create(aModule: TSQLVirtualTableModule;
................................................................................
  pointer(@SQLFieldTypeComp[sftObject]) := @StrComp;
{$ifndef NOVARIANTS}
  pointer(@SQLFieldTypeComp[sftVariant]) := @StrComp;
{$endif}
{$ifndef USENORMTOUPPER}
  pointer(@SQLFieldTypeComp[sftUTF8Text]) := @AnsiIComp;
{$endif}
  {$ifdef MSWINDOWS}
  ExeVersionRetrieve; // the sooner the better
  {$endif}
  SetCurrentThreadName('Main thread',[]);
  TTextWriter.SetDefaultJSONClass(TJSONSerializer);
  assert(sizeof(TServiceMethod)and 3=0,'wrong padding');
end.

  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 
................................................................................
  fInputCookieLastName := ''; // cache reset
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);
var clientHash, serverHash: RawUTF8;
begin
................................................................................
  const Error404Redirect: RawUTF8);
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);
end;

procedure TSQLRestServerURIContext.Redirect(const NewLocation: RawUTF8;
  PermanentChange: boolean);
................................................................................
    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;
................................................................................
  pointer(@SQLFieldTypeComp[sftObject]) := @StrComp;
{$ifndef NOVARIANTS}
  pointer(@SQLFieldTypeComp[sftVariant]) := @StrComp;
{$endif}
{$ifndef USENORMTOUPPER}
  pointer(@SQLFieldTypeComp[sftUTF8Text]) := @AnsiIComp;
{$endif}



  SetCurrentThreadName('Main thread',[]);
  TTextWriter.SetDefaultJSONClass(TJSONSerializer);
  assert(sizeof(TServiceMethod)and 3=0,'wrong padding');
end.

    a,i,f: integer;
    code,aggname,recname,parentrecname: RawUTF8;
    map: TSQLPropInfoList;
    rectypes: TRawUTF8DynArray;
begin
  {$ifdef KYLIX3} hier := nil; {$endif to make compiler happy}
  if DestinationSourceCodeFile='' then
    DestinationSourceCodeFile := ExtractFilePath(paramstr(0))+'ddsqlrecord.inc';
  for a := 0 to high(aAggregate) do begin
    hier := ClassHierarchyWithField(aAggregate[a]);
    code := code+#13#10'type';
    parentrecname := 'TSQLRecord';
    for i := 0 to high(hier) do begin
      aggname := RawUTF8(hier[i].ClassName);
      recname := 'TSQLRecord'+copy(aggname,2,100);

    a,i,f: integer;
    code,aggname,recname,parentrecname: RawUTF8;
    map: TSQLPropInfoList;
    rectypes: TRawUTF8DynArray;
begin
  {$ifdef KYLIX3} hier := nil; {$endif to make compiler happy}
  if DestinationSourceCodeFile='' then
    DestinationSourceCodeFile := ExeVersion.ProgramFilePath+'ddsqlrecord.inc';
  for a := 0 to high(aAggregate) do begin
    hier := ClassHierarchyWithField(aAggregate[a]);
    code := code+#13#10'type';
    parentrecname := 'TSQLRecord';
    for i := 0 to high(hier) do begin
      aggname := RawUTF8(hier[i].ClassName);
      recname := 'TSQLRecord'+copy(aggname,2,100);

      flistenType := ltPipeSync else begin
      flistenType := ltSocketSync;
      fSocket := TCrtSocket.Create(5000);
    end;
    exit;
  end;
  // if we reached here, exe was not called as a FastCGI process
  raise Exception.CreateFmt('%s not called as a FastCGI process',[paramstr(0)]);

{$else}
  not implemented yet: please use libfcgi.so version, which seems stable & fast
  under Linux
{$endif}
end;

destructor TFastCGIServer.Destroy;

      flistenType := ltPipeSync else begin
      flistenType := ltSocketSync;
      fSocket := TCrtSocket.Create(5000);
    end;
    exit;
  end;
  // if we reached here, exe was not called as a FastCGI process
  raise ESynException.CreateUTF8('%.Create: % not called as a FastCGI process',
    [Self,ExeVersion.ProgramFileName]);
{$else}
  not implemented yet: please use libfcgi.so version, which seems stable & fast
  under Linux
{$endif}
end;

destructor TFastCGIServer.Destroy;

    info: variant;
    SR: TSearchRec;
begin
  inherited Create(aInterface,aLogClass);
  // get views
  fViewTemplateFileTimestampMonitor := aParameters.FileTimestampMonitorAfterSeconds;
  if aParameters.Folder='' then
    fViewTemplateFolder := ExtractFilePath(ParamStr(0))+'Views\' else
    fViewTemplateFolder := IncludeTrailingPathDelimiter(aParameters.Folder);
  if not DirectoryExists(fViewTemplateFolder) then
    CreateDir(fViewTemplateFolder);
  if aParameters.CSVExtensions='' then
    LowerExt := ',html,json,css,' else
    LowerExt := ','+SysUtils.LowerCase(aParameters.CSVExtensions)+',';
  SetLength(fViews,fFactory.MethodsCount);
................................................................................
     IdemPropNameU(rawMethodName,STATIC_URI) then begin
    // code below will use a local in-memory cache, but would do the same as:
    // Ctxt.ReturnFileFromFolder(fViews.ViewTemplateFolder+STATIC_URI);
    static := fStaticCache.Value(rawFormat,#0);
    if static=#0 then begin
      if PosEx('..',rawFormat)>0 then // avoid injection
        static := '' else begin
        staticFileName := UTF8ToString(StringReplaceChars(rawFormat,'/','\'));
        static := StringFromFile(fViews.ViewTemplateFolder+STATIC_URI+'\'+staticFileName);
        if static<>'' then
          static := GetMimeContentType(nil,0,staticFileName)+#0+static;
      end;
      fStaticCache.Add(rawFormat,static);
    end;
    if static='' then
      Ctxt.Error('',HTML_NOTFOUND) else begin

    info: variant;
    SR: TSearchRec;
begin
  inherited Create(aInterface,aLogClass);
  // get views
  fViewTemplateFileTimestampMonitor := aParameters.FileTimestampMonitorAfterSeconds;
  if aParameters.Folder='' then
    fViewTemplateFolder := ExeVersion.ProgramFilePath+'Views'+PathDelim else
    fViewTemplateFolder := IncludeTrailingPathDelimiter(aParameters.Folder);
  if not DirectoryExists(fViewTemplateFolder) then
    CreateDir(fViewTemplateFolder);
  if aParameters.CSVExtensions='' then
    LowerExt := ',html,json,css,' else
    LowerExt := ','+SysUtils.LowerCase(aParameters.CSVExtensions)+',';
  SetLength(fViews,fFactory.MethodsCount);
................................................................................
     IdemPropNameU(rawMethodName,STATIC_URI) then begin
    // code below will use a local in-memory cache, but would do the same as:
    // Ctxt.ReturnFileFromFolder(fViews.ViewTemplateFolder+STATIC_URI);
    static := fStaticCache.Value(rawFormat,#0);
    if static=#0 then begin
      if PosEx('..',rawFormat)>0 then // avoid injection
        static := '' else begin
        staticFileName := UTF8ToString(StringReplaceChars(rawFormat,'/',PathDelim));
        static := StringFromFile(fViews.ViewTemplateFolder+STATIC_URI+PathDelim+staticFileName);
        if static<>'' then
          static := GetMimeContentType(nil,0,staticFileName)+#0+static;
      end;
      fStaticCache.Add(rawFormat,static);
    end;
    if static='' then
      Ctxt.Error('',HTML_NOTFOUND) else begin

procedure TSQLRestServerDB.GetAndPrepareStatement(const SQL: RawUTF8;
  ForceCacheStatement: boolean);
var i, maxParam,sqlite3param: integer;
    Types: TSQLParamTypeDynArray;
    Nulls: TSQLFieldBits;
    Values: TRawUTF8DynArray;

begin
  fStatementTimer.Start;
  fStatementSQL := SQL;
  fStatementGenericSQL := ExtractInlineParameters(SQL,Types,Values,maxParam,Nulls);
  if (maxParam=0) and not ForceCacheStatement then begin
    // SQL code with no valid :(...): internal parameters
    fStatementGenericSQL := '';
    fStaticStatement.Prepare(DB.DB,SQL);
    fStatement := @fStaticStatement;
    exit;
  end;
  fStatement := fStatementCache.Prepare(fStatementGenericSQL);







  // bind parameters
  sqlite3param := sqlite3.bind_parameter_count(fStatement^.Request);
  if sqlite3param<>maxParam then
    raise EORMException.CreateUTF8(
      '%.GetAndPrepareStatement(%) recognized % params, and % for SQLite3',
      [self,fStatementGenericSQL,maxParam,sqlite3param]);
  for i := 0 to maxParam-1 do
................................................................................
  if fStatement=@fStaticStatement then
    fStaticStatement.Close;
  fStatement := nil;
  fStatementSQL := '';
  fStatementGenericSQL := '';
  if E<>nil then
    fStatementLastException := FormatUTF8('% %',[E,ObjectToJSON(E)]);
end; 

procedure TSQLRestServerDB.FlushStatementCache;
begin
  DB.Lock;
  try
    fStatementCache.ReleaseAllDBStatements;
  finally
................................................................................
      if Res.VText=nil then
       sqlite3.result_text(Context,@NULCHAR,0,SQLITE_STATIC) else
       sqlite3.result_text(Context,Res.VText,-1,SQLITE_TRANSIENT_VIRTUALTABLE);
    ftBlob:
      sqlite3.result_blob(Context,Res.VBlob,Res.VBlobLen,SQLITE_TRANSIENT_VIRTUALTABLE);
    else begin
      {$ifdef WITHLOG}
      SynSQLite3Log.DebuggerNotify(sllWarning,[ord(Res.VType)],'SQLVarToSQlite3Context(%)');
      {$endif}
      result := false; // not handled type
      exit;
    end;
  end;
  result := true;
end;
................................................................................
  SQLITE_BLOB: begin
    Res.VType := ftBlob;
    Res.VBlobLen := sqlite3.value_bytes(Value);
    Res.VBlob := sqlite3.value_blob(Value);
  end;
  else begin
    {$ifdef WITHLOG}
    SynSQLite3Log.DebuggerNotify(sllWarning,[ValueType],'SQlite3ValueToSQLVar(%)');
    {$endif}
    Res.VType := ftUnknown;
  end;
  end;
end;

function TSQLVirtualTableModuleSQLite3.FileName(const aTableName: RawUTF8): TFileName;
................................................................................
    ModuleName: RawUTF8;
begin
  if Module<>nil then
    ModuleName := Module.ModuleName;
  if (Module=nil) or (Module.DB.DB<>DB) or
     (StrIComp(pointer(ModuleName),argv[0])<>0) then begin
    {$ifdef WITHLOG}
    SynSQLite3Log.DebuggerNotify(sllWarning,[argv[0],ModuleName],'vt_Create(%<>%)');
    {$endif}
    result := SQLITE_ERROR;
    exit;
  end;
  ppVTab := sqlite3.malloc(sizeof(TSQLite3VTab));
  if ppVTab=nil then begin
    result := SQLITE_NOMEM;
................................................................................
      exit;
    end;
  end;
  Structure := Table.Structure;
  result := sqlite3.declare_vtab(DB,pointer(Structure));
  if result<>SQLITE_OK then begin
    {$ifdef WITHLOG}
    SynSQLite3Log.DebuggerNotify(sllWarning,[ModuleName,Structure],'vt_Create(%) declare_vtab(%)');
    {$endif}
    Table.Free;
    sqlite3.free_(ppVTab);
    result := SQLITE_ERROR;
  end else
    ppVTab^.pInstance := Table;
end;
................................................................................
end;

function vt_Destroy(pVTab: PSQLite3VTab): Integer; {$ifndef SQLITE3_FASTCALL}cdecl;{$endif}
begin
  if TSQLVirtualTable(pvTab^.pInstance).Drop then
    result := SQLITE_OK else begin
    {$ifdef WITHLOG}
    SynSQLite3Log.DebuggerNotify(sllWarning,[],'vt_Destroy');
    {$endif}
    result := SQLITE_ERROR;
  end;
  vt_Disconnect(pVTab); // release memory
end;

function vt_BestIndex(var pVTab: TSQLite3VTab; var pInfo: TSQLite3IndexInfo): Integer;
................................................................................
    i, n: Integer;
begin
  result := SQLITE_ERROR;
  Table := TSQLVirtualTable(pvTab.pInstance);
  if (cardinal(pInfo.nOrderBy)>MAX_SQLFIELDS) or
     (cardinal(pInfo.nConstraint)>MAX_SQLFIELDS) then begin
    {$ifdef WITHLOG}
    SynSQLite3Log.DebuggerNotify(sllWarning,[pInfo.nOrderBy,pInfo.nConstraint],'nOrderBy=% nConstraint=%');
    {$endif}
    exit; // avoid buffer overflow
  end;
  Prepared := sqlite3.malloc(sizeof(TSQLVirtualTablePrepared));
  try
    // encode the incoming parameters into Prepared^ record
    fillchar(Prepared^,sizeof(Prepared^),0);
................................................................................
  if Prepared^.WhereCount<>argc then
    exit; // invalid prepared array
  for i := 0 to argc-1 do
    SQlite3ValueToSQLVar(argv[i],Prepared^.Where[i].Value);
  if TSQLVirtualTableCursor(pVtabCursor.pInstance).Search(Prepared^) then
    result := SQLITE_OK else
    {$ifdef WITHLOG}
    SynSQLite3Log.DebuggerNotify(sllWarning,[],'vt_Filter');
    {$endif}
end;

function vt_Open(var pVTab: TSQLite3VTab; var ppCursor: PSQLite3VTabCursor): Integer;
  {$ifndef SQLITE3_FASTCALL}cdecl;{$endif}
var Table: TSQLVirtualTable;
begin
................................................................................
  if ppCursor=nil then begin
    result := SQLITE_NOMEM;
    exit;
  end;
  Table := TSQLVirtualTable(pvTab.pInstance);
  if (Table=nil) or (Table.Module=nil) or (Table.Module.CursorClass=nil) then begin
    {$ifdef WITHLOG}
    SynSQLite3Log.DebuggerNotify(sllWarning,[],'vt_Open');
    {$endif}
    sqlite3.free_(ppCursor);
    result := SQLITE_ERROR;
    exit;
  end;
  ppCursor.pInstance := Table.Module.CursorClass.Create(Table);
  result := SQLITE_OK;
................................................................................
var Res: TSQLVar;
begin
  Res.VType := ftUnknown;
  if (N>=0) and TSQLVirtualTableCursor(pVtabCursor.pInstance).Column(N,Res) and
     SQLVarToSQlite3Context(Res,sContext) then
    result := SQLITE_OK else begin
    {$ifdef WITHLOG}
    SynSQLite3Log.DebuggerNotify(sllWarning,[N,ord(Res.VType)],'vt_Column(%) Res=%');
    {$endif}
    result := SQLITE_ERROR;
  end;
end;

function vt_Rowid(var pVtabCursor: TSQLite3VTabCursor; var pRowid: Int64): Integer;
  {$ifndef SQLITE3_FASTCALL}cdecl;{$endif}
................................................................................
    case Res.VType of
    ftInt64:    pRowID := Res.VInt64;
    ftDouble:   pRowID := trunc(Res.VDouble);
    ftCurrency: pRowID := trunc(Res.VCurrency);
    ftUTF8:     pRowID := GetInt64(Res.VText);
    else begin
      {$ifdef WITHLOG}
      SynSQLite3Log.DebuggerNotify(sllWarning,[ord(Res.VType)],'vt_Rowid Res=%');
      {$endif}
      exit;
    end;
    end;
    result := SQLITE_OK;
  end else begin
    {$ifdef WITHLOG}
    SynSQLite3Log.DebuggerNotify(sllWarning,[],'vt_Rowid Column');
    {$endif}
  end;
end;

function vt_Update(var pVTab: TSQLite3VTab;
  nArg: Integer; var ppArg: TSQLite3ValueArray;
  var pRowid: Int64): Integer; {$ifndef SQLITE3_FASTCALL}cdecl;{$endif}
................................................................................
    if RowID0=0 then
      OK := Table.Insert(RowID1,Values,pRowid) else
      OK := Table.Update(RowID0,RowID1,Values);
  end;
  if OK then
    result := SQLITE_OK else begin
    {$ifdef WITHLOG}
    SynSQLite3Log.DebuggerNotify(sllWarning,[pRowID],'vt_Update(%)');
    {$endif}
  end;
end;

function InternalTrans(pVTab: TSQLite3VTab; aState: TSQLVirtualTableTransaction;
  aSavePoint: integer): integer;
begin
  if TSQLVirtualTable(pvTab.pInstance).Transaction(aState,aSavePoint) then
    result := SQLITE_OK else begin
    {$ifdef WITHLOG}
    SynSQLite3Log.DebuggerNotify(sllWarning,[GetEnumName(TypeInfo(TSQLVirtualTableTransaction),
      ord(aState))^,aSavePoint],'Transaction(%,%)');
    {$endif}
    result := SQLITE_ERROR;
  end;
end;

function vt_Begin(var pVTab: TSQLite3VTab): Integer; {$ifndef SQLITE3_FASTCALL}cdecl;{$endif}
begin
................................................................................

function vt_Rename(var pVTab: TSQLite3VTab; const zNew: PAnsiChar): Integer;
  {$ifndef SQLITE3_FASTCALL}cdecl;{$endif}
begin
  if TSQLVirtualTable(pvTab.pInstance).Rename(RawUTF8(zNew)) then
    result := SQLITE_OK else begin
    {$ifdef WITHLOG}
    SynSQLite3Log.DebuggerNotify(sllWarning,[zNew],'vt_Rename(%)');
    {$endif}
    result := SQLITE_ERROR;
  end;
end;

procedure sqlite3InternalFreeModule(p: pointer); {$ifndef SQLITE3_FASTCALL}cdecl;{$endif}
begin

procedure TSQLRestServerDB.GetAndPrepareStatement(const SQL: RawUTF8;
  ForceCacheStatement: boolean);
var i, maxParam,sqlite3param: integer;
    Types: TSQLParamTypeDynArray;
    Nulls: TSQLFieldBits;
    Values: TRawUTF8DynArray;
    wasPrepared: boolean;
begin
  fStatementTimer.Start;
  fStatementSQL := SQL;
  fStatementGenericSQL := ExtractInlineParameters(SQL,Types,Values,maxParam,Nulls);
  if (maxParam=0) and not ForceCacheStatement then begin
    // SQL code with no valid :(...): internal parameters
    fStatementGenericSQL := '';
    fStaticStatement.Prepare(DB.DB,SQL);
    fStatement := @fStaticStatement;
    exit;
  end;
  fStatement := fStatementCache.Prepare(fStatementGenericSQL,@wasPrepared);
  if wasPrepared then begin
    {$ifdef WITHLOG}
    fLogClass.Add.Log(sllDB,'prepared % % %',
      [fStatementTimer.Stop,DB.FileNameWithoutPath,fStatementGenericSQL],self);
    {$endif}
    fStatementTimer.Start;
  end;
  // bind parameters
  sqlite3param := sqlite3.bind_parameter_count(fStatement^.Request);
  if sqlite3param<>maxParam then
    raise EORMException.CreateUTF8(
      '%.GetAndPrepareStatement(%) recognized % params, and % for SQLite3',
      [self,fStatementGenericSQL,maxParam,sqlite3param]);
  for i := 0 to maxParam-1 do
................................................................................
  if fStatement=@fStaticStatement then
    fStaticStatement.Close;
  fStatement := nil;
  fStatementSQL := '';
  fStatementGenericSQL := '';
  if E<>nil then
    fStatementLastException := FormatUTF8('% %',[E,ObjectToJSON(E)]);
end;

procedure TSQLRestServerDB.FlushStatementCache;
begin
  DB.Lock;
  try
    fStatementCache.ReleaseAllDBStatements;
  finally
................................................................................
      if Res.VText=nil then
       sqlite3.result_text(Context,@NULCHAR,0,SQLITE_STATIC) else
       sqlite3.result_text(Context,Res.VText,-1,SQLITE_TRANSIENT_VIRTUALTABLE);
    ftBlob:
      sqlite3.result_blob(Context,Res.VBlob,Res.VBlobLen,SQLITE_TRANSIENT_VIRTUALTABLE);
    else begin
      {$ifdef WITHLOG}
      SynSQLite3Log.DebuggerNotify(sllWarning,'SQLVarToSQlite3Context(%)',[ord(Res.VType)]);
      {$endif}
      result := false; // not handled type
      exit;
    end;
  end;
  result := true;
end;
................................................................................
  SQLITE_BLOB: begin
    Res.VType := ftBlob;
    Res.VBlobLen := sqlite3.value_bytes(Value);
    Res.VBlob := sqlite3.value_blob(Value);
  end;
  else begin
    {$ifdef WITHLOG}
    SynSQLite3Log.DebuggerNotify(sllWarning,'SQlite3ValueToSQLVar(%)',[ValueType]);
    {$endif}
    Res.VType := ftUnknown;
  end;
  end;
end;

function TSQLVirtualTableModuleSQLite3.FileName(const aTableName: RawUTF8): TFileName;
................................................................................
    ModuleName: RawUTF8;
begin
  if Module<>nil then
    ModuleName := Module.ModuleName;
  if (Module=nil) or (Module.DB.DB<>DB) or
     (StrIComp(pointer(ModuleName),argv[0])<>0) then begin
    {$ifdef WITHLOG}
    SynSQLite3Log.DebuggerNotify(sllWarning,'vt_Create(%<>%)',[argv[0],ModuleName]);
    {$endif}
    result := SQLITE_ERROR;
    exit;
  end;
  ppVTab := sqlite3.malloc(sizeof(TSQLite3VTab));
  if ppVTab=nil then begin
    result := SQLITE_NOMEM;
................................................................................
      exit;
    end;
  end;
  Structure := Table.Structure;
  result := sqlite3.declare_vtab(DB,pointer(Structure));
  if result<>SQLITE_OK then begin
    {$ifdef WITHLOG}
    SynSQLite3Log.DebuggerNotify(sllWarning,'vt_Create(%) declare_vtab(%)',[ModuleName,Structure]);
    {$endif}
    Table.Free;
    sqlite3.free_(ppVTab);
    result := SQLITE_ERROR;
  end else
    ppVTab^.pInstance := Table;
end;
................................................................................
end;

function vt_Destroy(pVTab: PSQLite3VTab): Integer; {$ifndef SQLITE3_FASTCALL}cdecl;{$endif}
begin
  if TSQLVirtualTable(pvTab^.pInstance).Drop then
    result := SQLITE_OK else begin
    {$ifdef WITHLOG}
    SynSQLite3Log.DebuggerNotify(sllWarning,'vt_Destroy',[]);
    {$endif}
    result := SQLITE_ERROR;
  end;
  vt_Disconnect(pVTab); // release memory
end;

function vt_BestIndex(var pVTab: TSQLite3VTab; var pInfo: TSQLite3IndexInfo): Integer;
................................................................................
    i, n: Integer;
begin
  result := SQLITE_ERROR;
  Table := TSQLVirtualTable(pvTab.pInstance);
  if (cardinal(pInfo.nOrderBy)>MAX_SQLFIELDS) or
     (cardinal(pInfo.nConstraint)>MAX_SQLFIELDS) then begin
    {$ifdef WITHLOG}
    SynSQLite3Log.DebuggerNotify(sllWarning,'nOrderBy=% nConstraint=%',[pInfo.nOrderBy,pInfo.nConstraint]);
    {$endif}
    exit; // avoid buffer overflow
  end;
  Prepared := sqlite3.malloc(sizeof(TSQLVirtualTablePrepared));
  try
    // encode the incoming parameters into Prepared^ record
    fillchar(Prepared^,sizeof(Prepared^),0);
................................................................................
  if Prepared^.WhereCount<>argc then
    exit; // invalid prepared array
  for i := 0 to argc-1 do
    SQlite3ValueToSQLVar(argv[i],Prepared^.Where[i].Value);
  if TSQLVirtualTableCursor(pVtabCursor.pInstance).Search(Prepared^) then
    result := SQLITE_OK else
    {$ifdef WITHLOG}
    SynSQLite3Log.DebuggerNotify(sllWarning,'vt_Filter',[]);
    {$endif}
end;

function vt_Open(var pVTab: TSQLite3VTab; var ppCursor: PSQLite3VTabCursor): Integer;
  {$ifndef SQLITE3_FASTCALL}cdecl;{$endif}
var Table: TSQLVirtualTable;
begin
................................................................................
  if ppCursor=nil then begin
    result := SQLITE_NOMEM;
    exit;
  end;
  Table := TSQLVirtualTable(pvTab.pInstance);
  if (Table=nil) or (Table.Module=nil) or (Table.Module.CursorClass=nil) then begin
    {$ifdef WITHLOG}
    SynSQLite3Log.DebuggerNotify(sllWarning,'vt_Open',[]);
    {$endif}
    sqlite3.free_(ppCursor);
    result := SQLITE_ERROR;
    exit;
  end;
  ppCursor.pInstance := Table.Module.CursorClass.Create(Table);
  result := SQLITE_OK;
................................................................................
var Res: TSQLVar;
begin
  Res.VType := ftUnknown;
  if (N>=0) and TSQLVirtualTableCursor(pVtabCursor.pInstance).Column(N,Res) and
     SQLVarToSQlite3Context(Res,sContext) then
    result := SQLITE_OK else begin
    {$ifdef WITHLOG}
    SynSQLite3Log.DebuggerNotify(sllWarning,'vt_Column(%) Res=%',[N,ord(Res.VType)]);
    {$endif}
    result := SQLITE_ERROR;
  end;
end;

function vt_Rowid(var pVtabCursor: TSQLite3VTabCursor; var pRowid: Int64): Integer;
  {$ifndef SQLITE3_FASTCALL}cdecl;{$endif}
................................................................................
    case Res.VType of
    ftInt64:    pRowID := Res.VInt64;
    ftDouble:   pRowID := trunc(Res.VDouble);
    ftCurrency: pRowID := trunc(Res.VCurrency);
    ftUTF8:     pRowID := GetInt64(Res.VText);
    else begin
      {$ifdef WITHLOG}
      SynSQLite3Log.DebuggerNotify(sllWarning,'vt_Rowid Res=%',[ord(Res.VType)]);
      {$endif}
      exit;
    end;
    end;
    result := SQLITE_OK;
  end else begin
    {$ifdef WITHLOG}
    SynSQLite3Log.DebuggerNotify(sllWarning,'vt_Rowid Column',[]);
    {$endif}
  end;
end;

function vt_Update(var pVTab: TSQLite3VTab;
  nArg: Integer; var ppArg: TSQLite3ValueArray;
  var pRowid: Int64): Integer; {$ifndef SQLITE3_FASTCALL}cdecl;{$endif}
................................................................................
    if RowID0=0 then
      OK := Table.Insert(RowID1,Values,pRowid) else
      OK := Table.Update(RowID0,RowID1,Values);
  end;
  if OK then
    result := SQLITE_OK else begin
    {$ifdef WITHLOG}
    SynSQLite3Log.DebuggerNotify(sllWarning,'vt_Update(%)',[pRowID]);
    {$endif}
  end;
end;

function InternalTrans(pVTab: TSQLite3VTab; aState: TSQLVirtualTableTransaction;
  aSavePoint: integer): integer;
begin
  if TSQLVirtualTable(pvTab.pInstance).Transaction(aState,aSavePoint) then
    result := SQLITE_OK else begin
    {$ifdef WITHLOG}
    SynSQLite3Log.DebuggerNotify(sllWarning,'Transaction(%,%)',
      [GetEnumName(TypeInfo(TSQLVirtualTableTransaction),ord(aState))^,aSavePoint]);
    {$endif}
    result := SQLITE_ERROR;
  end;
end;

function vt_Begin(var pVTab: TSQLite3VTab): Integer; {$ifndef SQLITE3_FASTCALL}cdecl;{$endif}
begin
................................................................................

function vt_Rename(var pVTab: TSQLite3VTab; const zNew: PAnsiChar): Integer;
  {$ifndef SQLITE3_FASTCALL}cdecl;{$endif}
begin
  if TSQLVirtualTable(pvTab.pInstance).Rename(RawUTF8(zNew)) then
    result := SQLITE_OK else begin
    {$ifdef WITHLOG}
    SynSQLite3Log.DebuggerNotify(sllWarning,'vt_Rename(%)',[zNew]);
    {$endif}
    result := SQLITE_ERROR;
  end;
end;

procedure sqlite3InternalFreeModule(p: pointer); {$ifndef SQLITE3_FASTCALL}cdecl;{$endif}
begin

  AllocConsole;
  {$endif}
  TSynLogTestLog := TSQLLog; // share the same log file with whole mORMot
  TSQLLog.Family.Level := LOG_STACKTRACE; // log errors by default
  if false then // "if not false then" will create around 550 MB of log file
  with TSQLLog.Family do begin
    Level := LOG_VERBOSE;
    //DestinationPath := ExtractFilePath(paramstr(0))+'logs'; folder should exist
    PerThreadLog := ptIdentifiedInOnFile;
    //HighResolutionTimeStamp := true;
    //RotateFileCount := 5; RotateFileSizeKB := 20*1024; // rotate by 20 MB logs
  end
  else
    TSQLLog.Family.Level := []; // NO log by default (ignore expected ERROR 400)
  // testing is performed by some dedicated classes defined in the above units

  AllocConsole;
  {$endif}
  TSynLogTestLog := TSQLLog; // share the same log file with whole mORMot
  TSQLLog.Family.Level := LOG_STACKTRACE; // log errors by default
  if false then // "if not false then" will create around 550 MB of log file
  with TSQLLog.Family do begin
    Level := LOG_VERBOSE;
    //DestinationPath := ExeVersion.ProgramFilePath+'logs'; folder should exist
    PerThreadLog := ptIdentifiedInOnFile;
    //HighResolutionTimeStamp := true;
    //RotateFileCount := 5; RotateFileSizeKB := 20*1024; // rotate by 20 MB logs
  end
  else
    TSQLLog.Family.Level := []; // NO log by default (ignore expected ERROR 400)
  // testing is performed by some dedicated classes defined in the above units

  fStartType   := SERVICE_AUTO_START;
  fStatusRec.dwServiceType := fServiceType;
  fStatusRec.dwCurrentState := SERVICE_STOPPED;
  fStatusRec.dwControlsAccepted := 31;
  fStatusRec.dwWin32ExitCode := NO_ERROR;
  {$ifndef NOMORMOTKERNEL}
  SQLite3Log.Add.Log(sllInfo,'% (%) running as "%"',
    [ServiceName,aDisplayName,ParamStr(0)],self);
  {$endif}
end;

procedure TService.CtrlHandle(Code: DWORD);
begin
  DoCtrlHandle(Code);
end;
................................................................................
    Free;
  end;
end;

function TService.Install(const Params: string): boolean;
var schService: SC_HANDLE;
    schSCManager: SC_HANDLE;
    ServicePath: String;
begin
  result := false;
  if installed then
    exit;
  ServicePath := paramstr(0);
  if Params<>'' then
    ServicePath := ServicePath+' '+Params;
  schSCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
  if (schSCManager>0) then begin
     schService := CreateService(schSCManager,
       pointer(fSName), pointer(fDName), SERVICE_ALL_ACCESS,
       fServiceType, fStartType, SERVICE_ERROR_NORMAL,

  fStartType   := SERVICE_AUTO_START;
  fStatusRec.dwServiceType := fServiceType;
  fStatusRec.dwCurrentState := SERVICE_STOPPED;
  fStatusRec.dwControlsAccepted := 31;
  fStatusRec.dwWin32ExitCode := NO_ERROR;
  {$ifndef NOMORMOTKERNEL}
  SQLite3Log.Add.Log(sllInfo,'% (%) running as "%"',
    [ServiceName,aDisplayName,ExeVersion.ProgramFullSpec],self);
  {$endif}
end;

procedure TService.CtrlHandle(Code: DWORD);
begin
  DoCtrlHandle(Code);
end;
................................................................................
    Free;
  end;
end;

function TService.Install(const Params: string): boolean;
var schService: SC_HANDLE;
    schSCManager: SC_HANDLE;
    ServicePath: TFileName;
begin
  result := false;
  if installed then
    exit;
  ServicePath := ExeVersion.ProgramFileName;
  if Params<>'' then
    ServicePath := ServicePath+' '+Params;
  schSCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
  if (schSCManager>0) then begin
     schService := CreateService(schSCManager,
       pointer(fSName), pointer(fDName), SERVICE_ALL_ACCESS,
       fServiceType, fStartType, SERVICE_ERROR_NORMAL,

procedure ComputeSearchPath(const Path: array of TFileName;
  out SearchPath: TFileNameDynArray);
var i: integer;
begin
  if length(Path)=0 then begin
    SetLength(SearchPath,1);
    SearchPath[0] := ExtractFilePath(paramstr(0)); // use .exe path
  end else begin
    SetLength(SearchPath,length(Path));
    for i := 0 to high(Path) do
      SearchPath[i] := Path[i];
  end;
end;

procedure ComputeSearchPath(const Path: array of TFileName;
  out SearchPath: TFileNameDynArray);
var i: integer;
begin
  if length(Path)=0 then begin
    SetLength(SearchPath,1);
    SearchPath[0] := ExeVersion.ProgramFilePath; // use .exe path
  end else begin
    SetLength(SearchPath,length(Path));
    for i := 0 to high(Path) do
      SearchPath[i] := Path[i];
  end;
end;

end;

procedure SetCurrentLanguage(const value: RawUTF8); overload;
begin
  SetCurrentLanguage(LanguageAbrToIndex(value));
end;

function ProgramName: AnsiString;
var i: integer;
begin
  result := AnsiString(ExtractFileName(paramstr(0)));
  i := Pos(RawUTF8('.'),RawUTF8(result));
  if i>0 then
    Setlength(result,i-1);
end;

{$ifdef USEFORMCREATEHOOK}

function i18nAddLanguageItems(MsgPath: TFileName; List: TStrings): integer;
var SR: TSearchRec;
    lng, index: TLanguages;
    Exists: set of TLanguages;
begin
  if MsgPath='' then
    MsgPath := ExtractFilePath(paramstr(0));
  result := -1; // no language selection if no language available
  fillchar(Exists,sizeof(Exists),0);
  include(Exists,lngEnglish); // English is always present (default built in EXE)
  if FindFirst(MsgPath+'*.msg', faAnyFile, SR)<>0 then
    exit;
  repeat
    lng := LanguageAbrToIndex(
................................................................................
  FreeAndNil(Messages);
  inherited;
end;

class function TLanguageFile.FileName(aLanguageLocale: TLanguages): TFileName;
begin
  if aLanguageLocale<>LANGUAGE_NONE then
    result :=  ExtractFilePath(paramstr(0))+
      Ansi7ToString(LanguageAbr[aLanguageLocale])+'.msg' else
    result := '';
end;

{$ifndef USEFORMCREATEHOOK}
procedure TLanguageFile.FormTranslate(Forms: array of TCustomForm);
var f: integer;
................................................................................
  end;
                       
begin
  // all code below use *A() Win32 API -> only english=Ansi text is expected here
  CB_Enum.Init(TypeInfo(TWinAnsiDynArray),CB_EnumStrings,nil,nil,Hash32Str,@CB_EnumStringsCount);
  ClassList := TList.Create;
  try
    assign(F,ChangeFileExt(paramstr(0),'.messages'));
    SetLength(buf,65536);
    settextbuf(F,buf[1],length(buf));
    Rewrite(F);
    // add all resourcestring values
    EnumResourceNamesA(HInstance,PAnsiChar(RT_STRING),@CB_EnumStringProc,0);
    // add all enumerates captions
    for i := 0 to high(EnumTypeInfo) do

end;

procedure SetCurrentLanguage(const value: RawUTF8); overload;
begin
  SetCurrentLanguage(LanguageAbrToIndex(value));
end;










{$ifdef USEFORMCREATEHOOK}

function i18nAddLanguageItems(MsgPath: TFileName; List: TStrings): integer;
var SR: TSearchRec;
    lng, index: TLanguages;
    Exists: set of TLanguages;
begin
  if MsgPath='' then
    MsgPath := ExeVersion.ProgramFilePath;
  result := -1; // no language selection if no language available
  fillchar(Exists,sizeof(Exists),0);
  include(Exists,lngEnglish); // English is always present (default built in EXE)
  if FindFirst(MsgPath+'*.msg', faAnyFile, SR)<>0 then
    exit;
  repeat
    lng := LanguageAbrToIndex(
................................................................................
  FreeAndNil(Messages);
  inherited;
end;

class function TLanguageFile.FileName(aLanguageLocale: TLanguages): TFileName;
begin
  if aLanguageLocale<>LANGUAGE_NONE then
    result :=  ExeVersion.ProgramFilePath+
      Ansi7ToString(LanguageAbr[aLanguageLocale])+'.msg' else
    result := '';
end;

{$ifndef USEFORMCREATEHOOK}
procedure TLanguageFile.FormTranslate(Forms: array of TCustomForm);
var f: integer;
................................................................................
  end;
                       
begin
  // all code below use *A() Win32 API -> only english=Ansi text is expected here
  CB_Enum.Init(TypeInfo(TWinAnsiDynArray),CB_EnumStrings,nil,nil,Hash32Str,@CB_EnumStringsCount);
  ClassList := TList.Create;
  try
    assign(F,ChangeFileExt(ExeVersion.ProgramFileName,'.messages'));
    SetLength(buf,65536);
    settextbuf(F,buf[1],length(buf));
    Rewrite(F);
    // add all resourcestring values
    EnumResourceNamesA(HInstance,PAnsiChar(RT_STRING),@CB_EnumStringProc,0);
    // add all enumerates captions
    for i := 0 to high(EnumTypeInfo) do

  // - defined as unreserved  = ALPHA / DIGIT / "-" / "." / "_" / "~"
  // in @http://tools.ietf.org/html/rfc3986#section-2.3
  IsURIUnreserved: set of byte =
    [ord('a')..ord('z'),ord('A')..ord('Z'),ord('0')..ord('9'),
     ord('-'),ord('.'),ord('_'),ord('~')];


{$ifdef MSWINDOWS}

{$M+} // to have existing RTTI for published properties
type
  /// used to retrieve version information from any EXE



  TFileVersion = class
  protected
    fDetailed: string;
    fBuildDateTime: TDateTime;
  public
    /// executable major version number
    Major: Integer;
................................................................................
    /// executable minor version number
    Minor: Integer;
    /// executable release version number
    Release: Integer;
    /// executable release build number
    Build: Integer;
    /// build year of this exe file
    BuildYear: integer;
    /// version info of the exe file as '3.1'
    // - return "string" type, i.e. UnicodeString for Delphi 2009+
    Main: string;
    /// retrieve application version from exe file name
    // - DefaultVersion is used if no information Version was included into
    // the executable resources (on compilation time)
    // - to retrieve version information from current executable, just call
    // ExeVersionRetrieve function, then use ExeVersion global variable
    constructor Create(const FileName: TFileName; DefaultVersion: integer);

    /// retrieve the version as a 32 bits integer with Major.Minor.Release

    function Version32: integer;
  published
    /// version info of the exe file as '3.1.0.123'
    // - return "string" type, i.e. UnicodeString for Delphi 2009+


    property Detailed: string read fDetailed write fDetailed;
    /// build date and time of this exe file
    property BuildDateTime: TDateTime read fBuildDateTime write fBuildDateTime;
  end;
{$M-}


................................................................................
  SecsPerMin    = 60;
  MSecsPerSec   = 1000;
  MinsPerDay    = HoursPerDay * MinsPerHour;
  SecsPerDay    = MinsPerDay * SecsPerMin;
  MSecsPerDay   = SecsPerDay * MSecsPerSec;
  UnixDateDelta = 25569;

{/ GetFileVersion returns the most significant 32 bits of a file's binary
  version number
  - Typically, this includes the major and minor version placed
  together in one 32-bit integer
  - It generally does not include the release or build numbers
  - It returns Cardinal(-1) if it failed }
function GetFileVersion(const FileName: TFileName): cardinal;
{$endif}



type
  /// the recognized Windows versions
  TWindowsVersion = (
    wUnknown, w2000, wXP, wXP_64, wServer2003, wServer2003_R2,
    wVista, wVista_64, wServer2008, wServer2008_64,
    wServer2008_R2, wServer2008_R2_64, wSeven, wSeven_64,
................................................................................
  // more optimistic/realistic value ($100000 instead of default $10000)
  SystemInfo: TSystemInfo;
  /// the current Operating System information, as retrieved for the current process
  OSVersionInfo: TOSVersionInfoEx;
  /// the current Operating System version, as retrieved for the current process
  OSVersion: TWindowsVersion;

  /// global information about the current executable and computer
  // - call ExeVersionRetrieve before using it (it is done by mORMot.pas unit)
  ExeVersion: record
    /// the main executable name, without any path nor extension
    ProgramName: RawUTF8;
    /// the main executable details, as used e.g. by TSynLog
    // - e.g. 'C:\Dev\lib\SQLite3\exe\TestSQL3.exe 0.0.0.0 (2011-03-29 11:09:06)'
    ProgramFullSpec: RawUTF8;
    /// the main executable file name (including full path)
    // - same as paramstr(0)
    ProgramFileName: TFileName;
    /// the main executable full path (excluding .exe file name)
    // - same as ExtractFilePath(paramstr(0))
    ProgramFilePath: TFileName;
    /// the full path of the running executable or library
    // - for an executable, same as paramstr(0) 
    // - for a library, will contain the whole .dll file name 
    InstanceFileName: TFileName;
    /// the current executable version
    Version: TFileVersion;
    /// the current computer host name
    Host: RawUTF8;
    /// the current computer user name
    User: RawUTF8;
  end;

/// initialize ExeVersion global variable, if not already done
procedure ExeVersionRetrieve(DefaultVersion: integer=0);

{/ this function can be used to create a GDI compatible window, able to
  receive Windows Messages for fast local communication
  - will return 0 on failure (window name already existing e.g.), or
    the created HWND handle on success
  - it will call the supplied message handler defined for a given Windows Message:
    for instance, define such a method in any object definition:
  !  procedure WMCopyData(var Msg : TWMCopyData); message WM_COPYDATA; }
................................................................................
/// compatibility function, to be implemented according to the running OS
// - expect more or less the same result as the homonymous Win32 API function
// - will call the corresponding function in SynKylix.pas or SynFPCLinux.pas 
function GetTickCount64: Int64;

{$endif MSWINDOWS}




































/// self-modifying code - change some memory buffer in the code segment
// - if Backup is not nil, it should point to a Size array of bytes, ready
// to contain the overridden code buffer, for further hook disabling
procedure PatchCode(Old,New: pointer; Size: integer; Backup: pointer=nil;
  LeaveUnprotected: boolean=false);

/// self-modifying code - change one PtrUInt in the code segment
................................................................................

var
  /// a global "Garbage collector", for some classes instances which must
  // live during whole main executable process
  // - used to avoid any memory leak with e.g. 'class var RecordProps', i.e.
  // some singleton or static objects
  // - to be used, e.g. as:
  // !  Version := TFileVersion.Create(InstanceFileName,DefaultVersion);
  // !  GarbageCollector.Add(Version);
  GarbageCollector: TObjectList;

  /// set to TRUE when the global "Garbage collector" are beeing freed
  GarbageCollectorFreeing: boolean;

/// a global "Garbage collector" for some TObject global variables which must
................................................................................
  end else
    P := StrUInt64(P,val);
  result := P;
end;


// some minimal RTTI const and types












{$ifdef FPC}

type
  /// available type families for Free Pascal RTTI values
  // - values differs from Delphi, and are taken from FPC typinfo.pp unit
  // - here below, we defined tkLString instead of FPC tkAString to match
................................................................................
    jnz @1
    xor eax,eax
@z:
end;
{$endif}

function StringReplaceChars(const Source: RawUTF8; OldChar, NewChar: AnsiChar): RawUTF8;
var c: AnsiChar;
    i: integer;
begin
  result := '';
  if Source='' then
    exit;
  SetLength(result,length(Source));
  i := 0;
  repeat
    c := PUTF8Char(pointer(Source))[i];
    if c=#0 then
      exit;
    if c=OldChar then
      c := NewChar;
    PUTF8Char(pointer(result))[i] := c;
    inc(i);
  until false;
end;

function PosI(uppersubstr: PUTF8Char; const str: RawUTF8): Integer;
var C: AnsiChar;
begin
  if uppersubstr<>nil then begin
    C := uppersubstr^;
................................................................................
    aWindow := 0;
    aWindowName := '';
    result := true;
  end else
    result := false;
end;

procedure ExeVersionRetrieve(DefaultVersion: integer);

const EXE_FMT: PUTF8Char = '% % (%)';








































































var Tmp: array[byte] of AnsiChar;
    TmpSize: cardinal;
    i: integer;


begin

  with ExeVersion do





  if Version=nil then begin

    ProgramFileName := paramstr(0);





    ProgramFilePath := ExtractFilePath(ProgramFileName);
    if IsLibrary then
      InstanceFileName := GetModuleName(HInstance) else
      InstanceFileName := ProgramFileName;
    Version := TFileVersion.Create(InstanceFileName,DefaultVersion);
    GarbageCollector.Add(Version);
    ProgramFullSpec := FormatUTF8(EXE_FMT,
      [ProgramFileName,Version.Detailed,DateTimeToIso8601(Version.BuildDateTime,True,' ')]);
    ProgramName := StringToUTF8(ExtractFileName(ProgramFileName));
    i := length(ProgramName);
    while i>0 do
      if ProgramName[i]='.' then begin
        SetLength(ProgramName,i-1);
        break;
      end else
      dec(i);

    TmpSize := sizeof(Tmp);
    GetComputerNameA(Tmp,TmpSize);
    Host := Tmp;
    TmpSize := sizeof(Tmp);
    GetUserNameA(Tmp,TmpSize);
    User := Tmp;




  end;
end;


{ TFileVersion }

constructor TFileVersion.Create(const FileName: TFileName;
  DefaultVersion: integer);
var Size, Size2: DWord;
    Pt: Pointer;
    Info: ^TVSFixedFileInfo;
    FileTime: TFILETIME;
    SystemTime: TSYSTEMTIME;
    tmp: TFileName;
begin
  Major := DefaultVersion;
  if FileName='' then
    exit;
  // GetFileVersionInfo modifies the filename parameter data while parsing.
  // Copy the string const into a local variable to create a writeable copy.
  SetString(tmp,PChar(FileName),length(FileName));
  Size := GetFileVersionInfoSize(pointer(tmp), Size2);
  if Size>0 then begin
    GetMem(Pt, Size);
    try
      GetFileVersionInfo(pointer(FileName), 0, Size, Pt);
      VerQueryValue(Pt, '\', pointer(Info), Size2);
      with Info^ do begin
        Major := dwFileVersionMS shr 16;
        Minor := word(dwFileVersionMS);
        Release := dwFileVersionLS shr 16;
        Build := word(dwFileVersionLS);
        BuildYear := 2010;
        if (dwFileDateLS<>0) and (dwFileDateMS<>0) then begin
          FileTime.dwLowDateTime:= dwFileDateLS; // built date from version info
          FileTime.dwHighDateTime:= dwFileDateMS;
          FileTimeToSystemTime(FileTime, SystemTime);
          fBuildDateTime := EncodeDate(
            SystemTime.wYear,SystemTime.wMonth,SystemTime.wDay);
          BuildYear := SystemTime.wYear;

        end;
      end;
    finally
      Freemem(Pt);
    end;
  end;
  Main := IntToString(Major)+'.'+IntToString(Minor);
  fDetailed := Main+ '.'+IntToString(Release)+'.'+IntToString(Build);
  if fBuildDateTime=0 then // get build date from file age
    fBuildDateTime := FileAgeToDateTime(FileName);
end;

function TFileVersion.Version32: integer;
begin
  result := Major shl 16+Minor shl 8+Release;
end;

{$else}

const
  _SC_PAGE_SIZE = $1000;

{$endif MSWINDOWS}



procedure PatchCode(Old,New: pointer; Size: integer; Backup: pointer=nil;
  LeaveUnprotected: boolean=false);
{$ifdef MSWINDOWS}
var RestoreProtection, Ignore: DWORD;
    i: integer;
................................................................................
  if VKind=dvArray then
    for result := 0 to VCount-1 do
      if VValue[result]=aValue then // rely on Variants.pas comparison
        exit;
  result := -1;
end;

procedure Exchg(P1,P2: PAnsiChar; count: integer);
var c: AnsiChar;
begin
  while count>0 do begin
    dec(count);
    c := P1[count];
    P1[count] := P2[count];
    P2[count] := c;
  end;
end;

procedure QuickSortDocVariant(names: PPointerArray; values: PVariantArray;
  L, R: PtrInt; Compare: TUTF8Compare);
var I, J, P: PtrInt;
    pivot, Tmp: pointer;
begin
  if L<R then
  repeat
................................................................................
  {$endif USEPACKAGES}
  {$endif CPUARM}
  {$endif FPC}
  InitSynCommonsConversionTables;
  {$ifdef MSWINDOWS}
  RetrieveSystemInfo;
  {$endif MSWINDOWS}

  // some type definition assertions
  Assert(SizeOf(TSynTableFieldType)=1); // as expected by TSynTableFieldProperties
  Assert(SizeOf(TSynTableFieldOptions)=1);
  {$ifndef NOVARIANTS}
  Assert(SizeOf(TSynTableData)=sizeof(TVarData));
  Assert(SizeOf(TDocVariantData)=sizeof(TVarData));
  {$endif NOVARIANTS}

finalization
  GarbageCollectorFree;
  if GlobalCriticalSectionInitialized then
    DeleteCriticalSection(GlobalCriticalSection);
end.

  // - defined as unreserved  = ALPHA / DIGIT / "-" / "." / "_" / "~"
  // in @http://tools.ietf.org/html/rfc3986#section-2.3
  IsURIUnreserved: set of byte =
    [ord('a')..ord('z'),ord('A')..ord('Z'),ord('0')..ord('9'),
     ord('-'),ord('.'),ord('_'),ord('~')];




{$M+} // to have existing RTTI for published properties
type
  /// used to retrieve version information from any EXE
  // - under Linux, all version numbers are set to 0 by default
  // - you should not have to use this class directly, but via the
  // ExeVersion global variable
  TFileVersion = class
  protected
    fDetailed: string;
    fBuildDateTime: TDateTime;
  public
    /// executable major version number
    Major: Integer;
................................................................................
    /// executable minor version number
    Minor: Integer;
    /// executable release version number
    Release: Integer;
    /// executable release build number
    Build: Integer;
    /// build year of this exe file
    BuildYear: word;
    /// version info of the exe file as '3.1'
    // - return "string" type, i.e. UnicodeString for Delphi 2009+
    Main: string;
    /// retrieve application version from exe file name
    // - DefaultVersion32 is used if no information Version was included into
    // the executable resources (on compilation time)
    // - you should not have to use this constructor, but rather access the
    // ExeVersion global variable
    constructor Create(const aFileName: TFileName;
      aMajor,aMinor,aRelease: integer);
    /// retrieve the version as a 32 bits integer with Major.Minor.Release
    // - following Major shl 16+Minor shl 8+Release bit pattern
    function Version32: integer;
  published
    /// version info of the exe file as '3.1.0.123'
    // - return "string" type, i.e. UnicodeString for Delphi 2009+
    // - under Linux, always return '0.0.0.0' if no custom version number
    // has been defined
    property Detailed: string read fDetailed write fDetailed;
    /// build date and time of this exe file
    property BuildDateTime: TDateTime read fBuildDateTime write fBuildDateTime;
  end;
{$M-}


................................................................................
  SecsPerMin    = 60;
  MSecsPerSec   = 1000;
  MinsPerDay    = HoursPerDay * MinsPerHour;
  SecsPerDay    = MinsPerDay * SecsPerMin;
  MSecsPerDay   = SecsPerDay * MSecsPerSec;
  UnixDateDelta = 25569;

/// GetFileVersion returns the most significant 32 bits of a file's binary
// version number
// - typically, this includes the major and minor version placed
// together in one 32-bit integer
// - generally does not include the release or build numbers
// - returns Cardinal(-1) in case of failure 
function GetFileVersion(const FileName: TFileName): cardinal;
{$endif}

{$ifdef MSWINDOWS}

type
  /// the recognized Windows versions
  TWindowsVersion = (
    wUnknown, w2000, wXP, wXP_64, wServer2003, wServer2003_R2,
    wVista, wVista_64, wServer2008, wServer2008_64,
    wServer2008_R2, wServer2008_R2_64, wSeven, wSeven_64,
................................................................................
  // more optimistic/realistic value ($100000 instead of default $10000)
  SystemInfo: TSystemInfo;
  /// the current Operating System information, as retrieved for the current process
  OSVersionInfo: TOSVersionInfoEx;
  /// the current Operating System version, as retrieved for the current process
  OSVersion: TWindowsVersion;






























{/ this function can be used to create a GDI compatible window, able to
  receive Windows Messages for fast local communication
  - will return 0 on failure (window name already existing e.g.), or
    the created HWND handle on success
  - it will call the supplied message handler defined for a given Windows Message:
    for instance, define such a method in any object definition:
  !  procedure WMCopyData(var Msg : TWMCopyData); message WM_COPYDATA; }
................................................................................
/// compatibility function, to be implemented according to the running OS
// - expect more or less the same result as the homonymous Win32 API function
// - will call the corresponding function in SynKylix.pas or SynFPCLinux.pas 
function GetTickCount64: Int64;

{$endif MSWINDOWS}

var
  /// global information about the current executable and computer
  // - this structure is initialized in this unit's initialization block below
  // - you can call SetExecutableVersion() with a custom version, if needed 
  ExeVersion: record
    /// the main executable name, without any path nor extension
    // - e.g. 'Test' for 'c:\pathto\Test.exe'
    ProgramName: RawUTF8;
    /// the main executable details, as used e.g. by TSynLog
    // - e.g. 'C:\Dev\lib\SQLite3\exe\TestSQL3.exe 0.0.0.0 (2011-03-29 11:09:06)'
    ProgramFullSpec: RawUTF8;
    /// the main executable file name (including full path)
    // - same as paramstr(0)
    ProgramFileName: TFileName;
    /// the main executable full path (excluding .exe file name)
    // - same as ExtractFilePath(paramstr(0))
    ProgramFilePath: TFileName;
    /// the full path of the running executable or library
    // - for an executable, same as paramstr(0)
    // - for a library, will contain the whole .dll file name
    InstanceFileName: TFileName;
    /// the current executable version
    Version: TFileVersion;
    /// the current computer host name
    Host: RawUTF8;
    /// the current computer user name
    User: RawUTF8;
  end;

/// initialize ExeVersion global variable, supplying a custom version number
// - by default, the version numbers will be retrieved at startup from the
// executable itself (if it was included at build time)
// - but you can use this function to set any custom version numbers
procedure SetExecutableVersion(aMajor,aMinor,aRelease: integer);

/// self-modifying code - change some memory buffer in the code segment
// - if Backup is not nil, it should point to a Size array of bytes, ready
// to contain the overridden code buffer, for further hook disabling
procedure PatchCode(Old,New: pointer; Size: integer; Backup: pointer=nil;
  LeaveUnprotected: boolean=false);

/// self-modifying code - change one PtrUInt in the code segment
................................................................................

var
  /// a global "Garbage collector", for some classes instances which must
  // live during whole main executable process
  // - used to avoid any memory leak with e.g. 'class var RecordProps', i.e.
  // some singleton or static objects
  // - to be used, e.g. as:
  // !  Version := TFileVersion.Create(InstanceFileName,DefaultVersion32);
  // !  GarbageCollector.Add(Version);
  GarbageCollector: TObjectList;

  /// set to TRUE when the global "Garbage collector" are beeing freed
  GarbageCollectorFreeing: boolean;

/// a global "Garbage collector" for some TObject global variables which must
................................................................................
  end else
    P := StrUInt64(P,val);
  result := P;
end;


// some minimal RTTI const and types

procedure Exchg(P1,P2: PAnsiChar; count: integer);
var c: AnsiChar;
begin
  while count>0 do begin
    dec(count);
    c := P1[count];
    P1[count] := P2[count];
    P2[count] := c;
  end;
end;

{$ifdef FPC}

type
  /// available type families for Free Pascal RTTI values
  // - values differs from Delphi, and are taken from FPC typinfo.pp unit
  // - here below, we defined tkLString instead of FPC tkAString to match
................................................................................
    jnz @1
    xor eax,eax
@z:
end;
{$endif}

function StringReplaceChars(const Source: RawUTF8; OldChar, NewChar: AnsiChar): RawUTF8;
var i,j,n: integer;
begin
  if (OldChar<>NewChar) and (Source<>'') then begin
    n := length(Source);
    for i := 0 to n-1 do
      if PAnsiChar(pointer(Source))[i]=OldChar then begin
        SetString(result,PAnsiChar(pointer(Source)),n);
        for j := i to n-1 do
          if PAnsiChar(pointer(Source))[j]=OldChar then
            PAnsiChar(pointer(result))[j] := NewChar;
        exit;
      end;
  end;
  result := Source;



end;

function PosI(uppersubstr: PUTF8Char; const str: RawUTF8): Integer;
var C: AnsiChar;
begin
  if uppersubstr<>nil then begin
    C := uppersubstr^;
................................................................................
    aWindow := 0;
    aWindowName := '';
    result := true;
  end else
    result := false;
end;



{$else}

const
  _SC_PAGE_SIZE = $1000;

{$endif MSWINDOWS}

{ TFileVersion }

constructor TFileVersion.Create(const aFileName: TFileName;
  aMajor,aMinor,aRelease: integer);
var M,D: word;
{$ifdef MSWINDOWS}
    Size, Size2: DWord;
    Pt: Pointer;
    Info: ^TVSFixedFileInfo;
    FileTime: TFILETIME;
    SystemTime: TSYSTEMTIME;
    tmp: TFileName;
{$endif}
begin
  Major := aMajor;
  Minor := aMinor;
  Release := aRelease;
  {$ifdef MSWINDOWS}
  if aFileName<>'' then begin
    // GetFileVersionInfo modifies the filename parameter data while parsing.
    // Copy the string const into a local variable to create a writeable copy.
    SetString(tmp,PChar(aFileName),length(aFileName));
    Size := GetFileVersionInfoSize(pointer(tmp), Size2);
    if Size>0 then begin
      GetMem(Pt, Size);
      try
        GetFileVersionInfo(pointer(aFileName), 0, Size, Pt);
        VerQueryValue(Pt, '\', pointer(Info), Size2);
        with Info^ do begin
          if Version32=0 then begin
            Major := dwFileVersionMS shr 16;
            Minor := word(dwFileVersionMS);
            Release := dwFileVersionLS shr 16;
          end;
          Build := word(dwFileVersionLS);
          BuildYear := 2010;
          if (dwFileDateLS<>0) and (dwFileDateMS<>0) then begin
            FileTime.dwLowDateTime:= dwFileDateLS; // built date from version info
            FileTime.dwHighDateTime:= dwFileDateMS;
            FileTimeToSystemTime(FileTime, SystemTime);
            fBuildDateTime := EncodeDate(
              SystemTime.wYear,SystemTime.wMonth,SystemTime.wDay);
          end;
        end;
      finally
        Freemem(Pt);
      end;
    end;
  end;
  {$endif}
  Main := IntToString(Major)+'.'+IntToString(Minor);
  fDetailed := Main+ '.'+IntToString(Release)+'.'+IntToString(Build);
  if fBuildDateTime=0 then  // get build date from file age
    fBuildDateTime := FileAgeToDateTime(aFileName);
  if fBuildDateTime<>0 then
    DecodeDate(fBuildDateTime,BuildYear,M,D);
end;

function TFileVersion.Version32: integer;
begin
  result := Major shl 16+Minor shl 8+Release;
end;

procedure SetExecutableVersion(aMajor,aMinor,aRelease: integer);
var setVersion,i: integer;
{$ifdef MSWINDOWS}
    Tmp: array[byte] of AnsiChar;
    TmpSize: cardinal;

{$else}
{$endif}
begin
  setVersion := aMajor shl 16+aMinor shl 8+aRelease;
  with ExeVersion do
  if Version<>nil then
    if Version.Version32=setVersion then
      exit else
      FreeAndNil(Version); // allow version number forcing
  with ExeVersion do
  if Version=nil then begin
    {$ifdef MSWINDOWS}
    ProgramFileName := paramstr(0);
    {$else}
    ProgramFileName := GetModuleName(hInstance);
    if ProgramFileName='' then
      ProgramFileName := ExpandFileName(paramstr(0));
    {$endif}
    ProgramFilePath := ExtractFilePath(ProgramFileName);
    if IsLibrary then
      InstanceFileName := GetModuleName(HInstance) else
      InstanceFileName := ProgramFileName;
    Version := TFileVersion.Create(InstanceFileName,aMajor,aMinor,aRelease);
    GarbageCollector.Add(Version);
    ProgramFullSpec := FormatUTF8('% % (%)',
      [ProgramFileName,Version.Detailed,DateTimeToIso8601(Version.BuildDateTime,True,' ')]);
    ProgramName := StringToUTF8(ExtractFileName(ProgramFileName));
    i := length(ProgramName);
    while i>0 do
      if ProgramName[i]='.' then begin
        SetLength(ProgramName,i-1);
        break;
      end else
      dec(i);
    {$ifdef MSWINDOWS}
    TmpSize := sizeof(Tmp);
    GetComputerNameA(Tmp,TmpSize);
    Host := Tmp;
    TmpSize := sizeof(Tmp);
    GetUserNameA(Tmp,TmpSize);
    User := Tmp;
    {$else}
    Host := GetHostName;
    {$ifdef KYLIX3}
    User := LibC.getpwuid(LibC.getuid)^.pw_name;
    {$endif}
    {$endif}





    if Host='' then
      Host := 'unknown';







    if User='' then























      User := 'unknown';
  end;
end;
























procedure PatchCode(Old,New: pointer; Size: integer; Backup: pointer=nil;
  LeaveUnprotected: boolean=false);
{$ifdef MSWINDOWS}
var RestoreProtection, Ignore: DWORD;
    i: integer;
................................................................................
  if VKind=dvArray then
    for result := 0 to VCount-1 do
      if VValue[result]=aValue then // rely on Variants.pas comparison
        exit;
  result := -1;
end;












procedure QuickSortDocVariant(names: PPointerArray; values: PVariantArray;
  L, R: PtrInt; Compare: TUTF8Compare);
var I, J, P: PtrInt;
    pivot, Tmp: pointer;
begin
  if L<R then
  repeat
................................................................................
  {$endif USEPACKAGES}
  {$endif CPUARM}
  {$endif FPC}
  InitSynCommonsConversionTables;
  {$ifdef MSWINDOWS}
  RetrieveSystemInfo;
  {$endif MSWINDOWS}
  SetExecutableVersion(0,0,0);
  // some type definition assertions
  Assert(SizeOf(TSynTableFieldType)=1); // as expected by TSynTableFieldProperties
  Assert(SizeOf(TSynTableFieldOptions)=1);
  {$ifndef NOVARIANTS}
  Assert(SizeOf(TSynTableData)=sizeof(TVarData));
  Assert(SizeOf(TDocVariantData)=sizeof(TVarData));
  {$endif NOVARIANTS}

finalization
  GarbageCollectorFree;
  if GlobalCriticalSectionInitialized then
    DeleteCriticalSection(GlobalCriticalSection);
end.

    Key: HKEY;
    Size: Cardinal;
    HR: Integer;
    CurrentDir: TFileName;
{$endif}
begin
  if aEmbedded then begin
    fLibName := ExtractFilePath(paramstr(0));
    if FileExists(LibName+FBLIBNAME[true]) then
      fLibName := LibName+FBLIBNAME[true] else
      fLibName := LibName+'Firebird\'+FBLIBNAME[true];
    if FileExists(fLibName) then begin
      {$ifdef MSWINDOWS}
      CurrentDir := GetCurrentDir;
      SetCurrentDir(ExtractFilePath(fLibName));

    Key: HKEY;
    Size: Cardinal;
    HR: Integer;
    CurrentDir: TFileName;
{$endif}
begin
  if aEmbedded then begin
    fLibName := ExeVersion.ProgramFilePath;
    if FileExists(LibName+FBLIBNAME[true]) then
      fLibName := LibName+FBLIBNAME[true] else
      fLibName := LibName+'Firebird\'+FBLIBNAME[true];
    if FileExists(fLibName) then begin
      {$ifdef MSWINDOWS}
      CurrentDir := GetCurrentDir;
      SetCurrentDir(ExtractFilePath(fLibName));

      if orhome<>'' then begin
        fLibraryPath := IncludeTrailingPathDelimiter(orhome)+'bin\oci.dll';
        fHandle := SafeLoadLibrary(fLibraryPath);
      end;
    end;
  end;
  if fHandle=0 then begin
    fLibraryPath := ExtractFilePath(paramstr(0))+'OracleInstantClient\oci.dll';
    fHandle := SafeLoadLibrary(fLibraryPath);
  end;
  if fHandle=0 then
    raise ESQLDBOracle.Create('Unable to find Oracle Client Interface (oci.dll)');
  P := @@ClientVersion;
  for i := 0 to High(OCI_ENTRIES) do begin
    P^ := GetProcAddress(fHandle,OCI_ENTRIES[i]);

      if orhome<>'' then begin
        fLibraryPath := IncludeTrailingPathDelimiter(orhome)+'bin\oci.dll';
        fHandle := SafeLoadLibrary(fLibraryPath);
      end;
    end;
  end;
  if fHandle=0 then begin
    fLibraryPath := ExeVersion.ProgramFilePath+'OracleInstantClient\oci.dll';
    fHandle := SafeLoadLibrary(fLibraryPath);
  end;
  if fHandle=0 then
    raise ESQLDBOracle.Create('Unable to find Oracle Client Interface (oci.dll)');
  P := @@ClientVersion;
  for i := 0 to High(OCI_ENTRIES) do begin
    P^ := GetProcAddress(fHandle,OCI_ENTRIES[i]);

  if result='' then
    exit;
  if aServerName<>'' then
    result := result+'//'+aServerName;
  if aLibraryLocation<>'' then begin
    result := result+'?LibLocation=';
    if aLibraryLocationAppendExePath then
      result := result+StringToUTF8(ExtractFilePath(ParamStr(0)));
    result := result+StringToUTF8(aLibraryLocation);
  end;
end;


{ TSQLDBZEOSConnection }

  if result='' then
    exit;
  if aServerName<>'' then
    result := result+'//'+aServerName;
  if aLibraryLocation<>'' then begin
    result := result+'?LibLocation=';
    if aLibraryLocationAppendExePath then
      result := result+StringToUTF8(ExeVersion.ProgramFilePath);
    result := result+StringToUTF8(aLibraryLocation);
  end;
end;


{ TSQLDBZEOSConnection }

        if aPath='' then begin
          aTime := FileAgeToDateTime(aOldLogFileName);
          if (aTime=0) or
             not DirectoryExists(ArchivePath+'log') and
             not CreateDir(ArchivePath+'log') then
            break;
          DecodeDate(aTime,Y,M,D);
          PCardinal(@tmp)^ := ord('l')+ord('o') shl 8+ord('g') shl 16+ord('\') shl 24;
          YearToPChar(Y,@tmp[4]);
          PWord(@tmp[8])^ := TwoDigitLookupW[M];
          PWord(@tmp[10])^ := ord('\');
          aPath := ArchivePath+Ansi7ToString(tmp,11);
        end;
        OnArchive(aOldLogFileName,aPath);
      until FindNext(SR)<>0;
    finally
      try
        OnArchive('',aPath); // mark no more .log file to archive -> close .zip
................................................................................
  if DebugHook<>0 then
    asm int 3 end; // force manual breakpoint if tests are run from the IDE
  {$endif}
end;

procedure TSynLog.LogFileHeader;
var WithinEvents: boolean;
{$ifdef MSWINDOWS}
    Env: PAnsiChar;
    P: PUTF8Char;
    L: Integer;
{$else}
    ExecutableName: string;
    uts: UtsName;
{$endif}
procedure NewLine;
begin
  if WithinEvents then begin
    fWriter.AddEndOfLine(sllNewRun);
    LogCurrentTime;
    fWriter.AddShort(LOG_LEVEL_TEXT[sllNewRun]);
  end else
................................................................................
begin
  if not QueryPerformanceFrequency(fFrequencyTimeStamp) then begin
    fFamily.HighResolutionTimeStamp := false;
    fFrequencyTimeStamp := 0;
  end else
    if (fFileRotationSize>0) or (fFileRotationNextHour<>0) then
      fFamily.HighResolutionTimeStamp := false;
  {$ifdef MSWINDOWS}
  ExeVersionRetrieve;
  {$endif}
  if InstanceMapFile=nil then
    GarbageCollectorFreeAndNil(InstanceMapFile,TSynMapFile.Create);
  WithinEvents := fWriter.WrittenBytes>0;
  // array of const is buggy under Delphi 5 :( -> use fWriter.Add*() below
  if WithinEvents then begin
    LogCurrentTime;
    fWriter.AddShort(LOG_LEVEL_TEXT[sllNewRun]);
    fWriter.AddChars('=',50);
    NewLine;
  end;
  {$ifdef MSWINDOWS}
  with ExeVersion, SystemInfo, OSVersionInfo, fWriter do begin
    AddString(ProgramFullSpec);
    NewLine;
    AddShort('Host=');  AddString(Host);
    AddShort(' User='); AddString(User);


    AddShort(' CPU=');  Add(dwNumberOfProcessors); Add('*');
    Add(wProcessorArchitecture); Add('-'); Add(wProcessorLevel); Add('-');
    Add(wProcessorRevision);
    AddShort(' OS='); Add(ord(OSVersion)); Add('.'); Add(wServicePackMajor);
    Add('='); Add(dwMajorVersion); Add('.'); Add(dwMinorVersion); Add('.');
    Add(dwBuildNumber);
    AddShort(' Wow64='); Add(integer(IsWow64));















    AddShort(' Freq='); Add(fFrequencyTimeStamp);
    if IsLibrary then begin
      AddShort(' Instance=');
      AddNoJSONEscapeString(InstanceFileName);
    end;

    NewLine;
    AddShort('Environment variables=');
    Env := GetEnvironmentStringsA;
    P := pointer(Env);
    while P^<>#0 do begin
      L := StrLen(P);
      if (L>0) and (P^<>'=') then begin
................................................................................
        AddNoJSONEscape(P,L);
        Add(#9);
      end;
      inc(P,L+1);
    end;
    FreeEnvironmentStringsA(Env);
    CancelLastChar; // trim last #9
    {$else}
  with fWriter do begin
    ExecutableName := GetModuleName(hInstance);
    if ExecutableName='' then
      ExecutableName := paramstr(0);
    if ExecutableName='' then
      AddShort('nomodulename') else
      AddNoJSONEscapeString(ExecutableName);
    AddShort(' unknown (');
    if ExecutableName='' then
      AddDateTime(now) else
      AddDateTime(FileAgeToDateTime(ExecutableName));
    Add(')');
    NewLine;
    AddShort('Host='); AddString(GetHostName);
    AddShort(' User=');
    {$ifdef KYLIX3}
    AddNoJSONEscape(LibC.getpwuid(LibC.getuid)^.pw_name);
    AddShort(' CPU=');
    Add(LibC.get_nprocs); Add('/'); Add(LibC.get_nprocs_conf);
    AddShort(' OS=');
    uname(uts);
    {$else}
    AddShort('unknown CPU=unknown OS=');
    FPUname(uts);
    {$endif}
    AddNoJSONEscape(@uts.sysname); Add('-'); AddNoJSONEscape(@uts.release);
    AddReplace(@uts.version,' ','-');
    AddShort(' Wow64=0 Freq=');
    Add(fFrequencyTimeStamp);
    {$endif}
    NewLine;
    AddClassName(self.ClassType);
    AddShort(' '+SYNOPSE_FRAMEWORK_FULLVERSION+' ');
    AddDateTime(Now);
    if WithinEvents then
      AddEndOfLine(sllNone) else
................................................................................
end;

procedure TSynLog.ComputeFileName;
var timeNow,hourRotate,timeBeforeRotate: TDateTime;
begin
  fFileName := fFamily.fCustomFileName;
  if fFileName='' then begin
    {$ifdef MSWINDOWS}
    ExeVersionRetrieve;
    fFileName := UTF8ToString(ExeVersion.ProgramName);
    if fFamily.IncludeComputerNameInFileName then
      fFileName := fFileName+' ('+UTF8ToString(ExeVersion.Host)+')';
    {$else}
    fFileName := GetFileNameWithoutExt(ExtractFileName(ParamStr(0)));
    {$endif}
  end;
  fFileRotationSize := 0;
  if fFamily.fRotateFileCount>0 then begin
    if fFamily.fRotateFileSize>0 then
      fFileRotationSize := fFamily.fRotateFileSize shl 10; // size KB -> B
    if fFamily.fRotateFileAtHour in [0..23] then begin
      hourRotate := EncodeTime(fFamily.fRotateFileAtHour,0,0,0);

        if aPath='' then begin
          aTime := FileAgeToDateTime(aOldLogFileName);
          if (aTime=0) or
             not DirectoryExists(ArchivePath+'log') and
             not CreateDir(ArchivePath+'log') then
            break;
          DecodeDate(aTime,Y,M,D);
          PCardinal(@tmp)^ := ord('l')+ord('o') shl 8+ord('g') shl 16+ord(PathDelim) shl 24;
          YearToPChar(Y,@tmp[4]);
          PWord(@tmp[8])^ := TwoDigitLookupW[M];
          PWord(@tmp[10])^ := ord(PathDelim);
          aPath := ArchivePath+Ansi7ToString(tmp,11);
        end;
        OnArchive(aOldLogFileName,aPath);
      until FindNext(SR)<>0;
    finally
      try
        OnArchive('',aPath); // mark no more .log file to archive -> close .zip
................................................................................
  if DebugHook<>0 then
    asm int 3 end; // force manual breakpoint if tests are run from the IDE
  {$endif}
end;

procedure TSynLog.LogFileHeader;
var WithinEvents: boolean;
    {$ifdef MSWINDOWS}
    Env: PAnsiChar;
    P: PUTF8Char;
    L: Integer;
    {$else}

    uts: UtsName;
    {$endif}
procedure NewLine;
begin
  if WithinEvents then begin
    fWriter.AddEndOfLine(sllNewRun);
    LogCurrentTime;
    fWriter.AddShort(LOG_LEVEL_TEXT[sllNewRun]);
  end else
................................................................................
begin
  if not QueryPerformanceFrequency(fFrequencyTimeStamp) then begin
    fFamily.HighResolutionTimeStamp := false;
    fFrequencyTimeStamp := 0;
  end else
    if (fFileRotationSize>0) or (fFileRotationNextHour<>0) then
      fFamily.HighResolutionTimeStamp := false;



  if InstanceMapFile=nil then
    GarbageCollectorFreeAndNil(InstanceMapFile,TSynMapFile.Create);
  WithinEvents := fWriter.WrittenBytes>0;
  // array of const is buggy under Delphi 5 :( -> use fWriter.Add*() below
  if WithinEvents then begin
    LogCurrentTime;
    fWriter.AddShort(LOG_LEVEL_TEXT[sllNewRun]);
    fWriter.AddChars('=',50);
    NewLine;
  end;

  with ExeVersion, fWriter do begin
    AddString(ProgramFullSpec);
    NewLine;
    AddShort('Host=');  AddString(Host);
    AddShort(' User='); AddString(User);
    {$ifdef MSWINDOWS}
    with SystemInfo, OSVersionInfo do begin
      AddShort(' CPU=');  Add(dwNumberOfProcessors); Add('*');
      Add(wProcessorArchitecture); Add('-'); Add(wProcessorLevel); Add('-');
      Add(wProcessorRevision);
      AddShort(' OS='); Add(ord(OSVersion)); Add('.'); Add(wServicePackMajor);
      Add('='); Add(dwMajorVersion); Add('.'); Add(dwMinorVersion); Add('.');
      Add(dwBuildNumber);
      AddShort(' Wow64='); Add(integer(IsWow64));
    end;
    {$else}
    {$ifdef KYLIX3}
    AddShort(' CPU=');
    Add(LibC.get_nprocs); Add('/'); Add(LibC.get_nprocs_conf);
    AddShort(' OS=');
    uname(uts);
    {$else}
    AddShort(' CPU=unknown OS=');
    FPUname(uts);
    {$endif}
    AddNoJSONEscape(@uts.sysname); Add('-'); AddNoJSONEscape(@uts.release);
    AddReplace(@uts.version,' ','-');
    AddShort(' Wow64=0');
    {$endif}
    AddShort(' Freq='); Add(fFrequencyTimeStamp);
    if IsLibrary then begin
      AddShort(' Instance=');
      AddNoJSONEscapeString(InstanceFileName);
    end;
    {$ifdef MSWINDOWS}
    NewLine;
    AddShort('Environment variables=');
    Env := GetEnvironmentStringsA;
    P := pointer(Env);
    while P^<>#0 do begin
      L := StrLen(P);
      if (L>0) and (P^<>'=') then begin
................................................................................
        AddNoJSONEscape(P,L);
        Add(#9);
      end;
      inc(P,L+1);
    end;
    FreeEnvironmentStringsA(Env);
    CancelLastChar; // trim last #9






























    {$endif}
    NewLine;
    AddClassName(self.ClassType);
    AddShort(' '+SYNOPSE_FRAMEWORK_FULLVERSION+' ');
    AddDateTime(Now);
    if WithinEvents then
      AddEndOfLine(sllNone) else
................................................................................
end;

procedure TSynLog.ComputeFileName;
var timeNow,hourRotate,timeBeforeRotate: TDateTime;
begin
  fFileName := fFamily.fCustomFileName;
  if fFileName='' then begin


    fFileName := UTF8ToString(ExeVersion.ProgramName);
    if fFamily.IncludeComputerNameInFileName then
      fFileName := fFileName+' ('+UTF8ToString(ExeVersion.Host)+')';



  end;
  fFileRotationSize := 0;
  if fFamily.fRotateFileCount>0 then begin
    if fFamily.fRotateFileSize>0 then
      fFileRotationSize := fFamily.fRotateFileSize shl 10; // size KB -> B
    if fFamily.fRotateFileAtHour in [0..23] then begin
      hourRotate := EncodeTime(fFamily.fRotateFileAtHour,0,0,0);

    /// hashing wrapper associated to the Cache[] array
    Caches: TDynArrayHashed;
    /// the associated SQLite3 database instance
    DB: TSQLite3DB;
    /// intialize the cache
    procedure Init(aDB: TSQLite3DB);
    /// add or retrieve a generic SQL (with ? parameters) statement from cache
    function Prepare(const GenericSQL: RawUTF8): PSQLRequest;
    // used internaly to release all prepared statements from Cache[]
    procedure ReleaseAllDBStatements;
  end;

  /// those classes can be used to define custom SQL functions inside a TSQLDataBase
  TSQLDataBaseSQLFunction = class
  protected
................................................................................
  if (self=nil) or (DB=0) then
    result := 0 else
    try
      Lock;
      result := sqlite3.changes(DB);
      {$ifdef WITHLOG}
      if fLog<>nil then
        fLog.Add.Log(sllDB,'LastChangeCount=%',result,self);
      {$endif}
    finally
      UnLock;
    end;
end;

procedure TSQLDataBase.GetTableNames(var Names: TRawUTF8DynArray);
................................................................................
  EnterCriticalSection(fLock); // cache access is also protected by fLock
  try
    if isSelect(pointer(aSQL)) then begin
      result := fCache.Find(aSQL,aResultCount); // try to get JSON result from cache
      if result<>'' then begin
        {$ifdef WITHLOG}
        if fLog<>nil then begin
          fLog.Add.Log(sllSQL,aSQL,self,2048);
          fLog.Add.Log(sllCache,'from cache',self);
          fLog.Add.Log(sllResult,result,self,fLogResultMaximumSize);
        end;
        {$endif}
        LeaveCriticalSection(fLock); // found in cache -> leave critical section
      end;
    end else begin
      // UPDATE, INSERT or any non SELECT statement
................................................................................
    Backup: TSQLite3Backup;
begin
  result := false;
  if (self=nil) or (BackupFileName='') or not Assigned(sqlite3.backup_init) or
     (fBackupBackgroundInProcess<>nil) then
    exit;
  {$ifdef WITHLOG}
  fLog.Add.Log(sllDB,self);

  {$endif}
  if FileExists(BackupFileName) then
    if not DeleteFile(BackupFileName) then
      exit;
  Dest := TSQLDatabase.Create(BackupFileName,aPassword);
  Backup := sqlite3.backup_init(Dest.DB,'main',DB,'main');
  if Backup=0 then begin
................................................................................

function TSQLDataBase.DBClose: integer;
begin
  result := SQLITE_OK;
  if (self=nil) or (fDB=0) then
    exit;
  {$ifdef WITHLOG}
  fLog.Enter.Log(sllDB,self);
  {$endif}
  if (sqlite3=nil) or not Assigned(sqlite3.close) then
    raise ESQLite3Exception.Create('DBClose called with no sqlite3 global');
  if fBackupBackgroundInProcess<>nil then
    BackupBackgroundWaitUntilFinished;
  result := sqlite3.close(fDB);
  fDB := 0;
................................................................................
  if fOpenV2Flags<>(SQLITE_OPEN_READWRITE or SQLITE_OPEN_CREATE) then
    result := sqlite3.open_v2(pointer(utf8),fDB,fOpenV2Flags,nil) else
  {$endif}
    result := sqlite3.open(pointer(utf8),fDB);
  if result<>SQLITE_OK then begin
    {$ifdef WITHLOG}
    if Log<>nil then
      Log.Log(sllError,'open ("%") failed with error % (%): %',
        [utf8,sqlite3_resultToErrorText(result),result,sqlite3.errmsg(fDB)]);
    {$endif}
    sqlite3.close(fDB); // should always be closed, even on failure
    fDB := 0;
    exit;
  end;
  if Assigned(sqlite3.key) and (fPassword<>'') and
................................................................................
  // reallocate all TSQLDataBaseSQLFunction for re-Open (TSQLRestServerDB.Backup)
  for i := 0 to fSQLFunctions.Count-1 do
    TSQLDataBaseSQLFunction(fSQLFunctions.List[i]).CreateFunction(DB);
  // tune up execution speed
  if not fIsMemory then
    CacheSize := 10000;
  {$ifdef WITHLOG}
  Log.Log(sllDB,self);
  {$endif}
end;

function TSQLDataBase.GetUserVersion: cardinal;
begin
  result := ExecuteNoExceptionInt64('PRAGMA user_version');
end;
................................................................................
procedure TSQLDataBase.CacheFlush;
begin
  if self=nil then
    exit;
  if InternalState<>nil then
    inc(InternalState^);
  if fCache.Reset then
  {$ifdef WITHLOG}
    if fLog<>nil then
      fLog.Add.Log(sllCache,'cache flushed',self);
  {$endif}
end;

procedure TSQLDataBase.RegisterSQLFunction(aFunction: TSQLDataBaseSQLFunction);
var i: integer;
begin
  if (self=nil) or (aFunction=nil) then
    exit;
................................................................................
    if (FunctionParametersCount=aFunction.FunctionParametersCount) and
       IdemPropNameU(FunctionName,aFunction.FunctionName) then begin
      aFunction.Free;
      exit; // already registered with the same name and parameters count
    end;
  {$ifdef WITHLOG}
  if fLog<>nil then
    fLog.Add.Log(sllDB,'RegisterSQLFunction '+aFunction.FunctionName,self);

  {$endif}
  fSQLFunctions.Add(aFunction);
  if DB<>0 then
    // DB already opened -> register this custom function
    aFunction.CreateFunction(DB);
end;

................................................................................
  if aFunctionName='' then
    fSQLName := RawUTF8(copy(ClassName,2,maxInt)) else
    fSQLName := aFunctionName;
end;

function TSQLDataBaseSQLFunction.CreateFunction(DB: TSQLite3DB): Integer;
begin
  if self<>nil then begin
    result := sqlite3.create_function(DB,pointer(fSQLName),
      FunctionParametersCount,SQLITE_ANY,self,fInternalFunction,nil,nil);
    {$ifdef WITHLOGSQLFUNCTION}
    if (result<>SQLITE_OK) and (fLog<>nil) then
      fLog.Add.Log(sllError,'register SQL function failed: '+FunctionName,self);
    {$endif}
  end else
    result := SQLITE_ERROR;
end;


{ TSQLDataBaseSQLFunctionDynArray }

procedure InternalSQLFunctionDynArrayBlob(Context: TSQLite3FunctionContext;
................................................................................

procedure TSQLStatementCached.Init(aDB: TSQLite3DB);
begin
  Caches.Init(TypeInfo(TSQLStatementCacheDynArray),Cache,nil,nil,nil,@Count);
  DB := aDB;
end;

function TSQLStatementCached.Prepare(const GenericSQL: RawUTF8): PSQLRequest;

var added: boolean;
    ndx: integer;

begin
  ndx := Caches.FindHashedForAdding(GenericSQL,added);
  with Cache[ndx] do begin
    if added then begin

      StatementSQL := GenericSQL;
      Statement.Prepare(DB,GenericSQL);


    end else begin
      //Statement.BindReset; // slow down the process, and is not mandatory
      Statement.Reset;


    end;
    result := @Statement;
  end;
end;

procedure TSQLStatementCached.ReleaseAllDBStatements;
var i: integer;

    /// hashing wrapper associated to the Cache[] array
    Caches: TDynArrayHashed;
    /// the associated SQLite3 database instance
    DB: TSQLite3DB;
    /// intialize the cache
    procedure Init(aDB: TSQLite3DB);
    /// add or retrieve a generic SQL (with ? parameters) statement from cache
    function Prepare(const GenericSQL: RawUTF8; WasPrepared: PBoolean=nil): PSQLRequest;
    // used internaly to release all prepared statements from Cache[]
    procedure ReleaseAllDBStatements;
  end;

  /// those classes can be used to define custom SQL functions inside a TSQLDataBase
  TSQLDataBaseSQLFunction = class
  protected
................................................................................
  if (self=nil) or (DB=0) then
    result := 0 else
    try
      Lock;
      result := sqlite3.changes(DB);
      {$ifdef WITHLOG}
      if fLog<>nil then
        fLog.Add.Log(sllDB,'% LastChangeCount=%',[FileNameWithoutPath,result],self);
      {$endif}
    finally
      UnLock;
    end;
end;

procedure TSQLDataBase.GetTableNames(var Names: TRawUTF8DynArray);
................................................................................
  EnterCriticalSection(fLock); // cache access is also protected by fLock
  try
    if isSelect(pointer(aSQL)) then begin
      result := fCache.Find(aSQL,aResultCount); // try to get JSON result from cache
      if result<>'' then begin
        {$ifdef WITHLOG}
        if fLog<>nil then begin
          fLog.Add.Log(sllSQL,'from cache % %',[FileNameWithoutPath,aSQL],self);

          fLog.Add.Log(sllResult,result,self,fLogResultMaximumSize);
        end;
        {$endif}
        LeaveCriticalSection(fLock); // found in cache -> leave critical section
      end;
    end else begin
      // UPDATE, INSERT or any non SELECT statement
................................................................................
    Backup: TSQLite3Backup;
begin
  result := false;
  if (self=nil) or (BackupFileName='') or not Assigned(sqlite3.backup_init) or
     (fBackupBackgroundInProcess<>nil) then
    exit;
  {$ifdef WITHLOG}
  fLog.Add.Log(sllDB,'BackupBackground("%") started on %',
    [BackupFileName,FileNameWithoutPath],self);
  {$endif}
  if FileExists(BackupFileName) then
    if not DeleteFile(BackupFileName) then
      exit;
  Dest := TSQLDatabase.Create(BackupFileName,aPassword);
  Backup := sqlite3.backup_init(Dest.DB,'main',DB,'main');
  if Backup=0 then begin
................................................................................

function TSQLDataBase.DBClose: integer;
begin
  result := SQLITE_OK;
  if (self=nil) or (fDB=0) then
    exit;
  {$ifdef WITHLOG}
  fLog.Enter.Log(sllDB,'closing "%"',[FileName],self);
  {$endif}
  if (sqlite3=nil) or not Assigned(sqlite3.close) then
    raise ESQLite3Exception.Create('DBClose called with no sqlite3 global');
  if fBackupBackgroundInProcess<>nil then
    BackupBackgroundWaitUntilFinished;
  result := sqlite3.close(fDB);
  fDB := 0;
................................................................................
  if fOpenV2Flags<>(SQLITE_OPEN_READWRITE or SQLITE_OPEN_CREATE) then
    result := sqlite3.open_v2(pointer(utf8),fDB,fOpenV2Flags,nil) else
  {$endif}
    result := sqlite3.open(pointer(utf8),fDB);
  if result<>SQLITE_OK then begin
    {$ifdef WITHLOG}
    if Log<>nil then
      Log.Log(sllError,'sqlite3_open ("%") failed with error % (%): %',
        [utf8,sqlite3_resultToErrorText(result),result,sqlite3.errmsg(fDB)]);
    {$endif}
    sqlite3.close(fDB); // should always be closed, even on failure
    fDB := 0;
    exit;
  end;
  if Assigned(sqlite3.key) and (fPassword<>'') and
................................................................................
  // reallocate all TSQLDataBaseSQLFunction for re-Open (TSQLRestServerDB.Backup)
  for i := 0 to fSQLFunctions.Count-1 do
    TSQLDataBaseSQLFunction(fSQLFunctions.List[i]).CreateFunction(DB);
  // tune up execution speed
  if not fIsMemory then
    CacheSize := 10000;
  {$ifdef WITHLOG}
  Log.Log(sllDB,'"%" database file opened',[FileName],self);
  {$endif}
end;

function TSQLDataBase.GetUserVersion: cardinal;
begin
  result := ExecuteNoExceptionInt64('PRAGMA user_version');
end;
................................................................................
procedure TSQLDataBase.CacheFlush;
begin
  if self=nil then
    exit;
  if InternalState<>nil then
    inc(InternalState^);
  if fCache.Reset then
   {$ifdef WITHLOG}
    if fLog<>nil then
      fLog.Add.Log(sllCache,'% cache flushed',[FileNameWithoutPath],self);
    {$endif}
end;

procedure TSQLDataBase.RegisterSQLFunction(aFunction: TSQLDataBaseSQLFunction);
var i: integer;
begin
  if (self=nil) or (aFunction=nil) then
    exit;
................................................................................
    if (FunctionParametersCount=aFunction.FunctionParametersCount) and
       IdemPropNameU(FunctionName,aFunction.FunctionName) then begin
      aFunction.Free;
      exit; // already registered with the same name and parameters count
    end;
  {$ifdef WITHLOG}
  if fLog<>nil then
    fLog.Add.Log(sllDB,'% RegisterSQLFunction("%") %',
      [FileNameWithoutPath,aFunction.FunctionName],self);
  {$endif}
  fSQLFunctions.Add(aFunction);
  if DB<>0 then
    // DB already opened -> register this custom function
    aFunction.CreateFunction(DB);
end;

................................................................................
  if aFunctionName='' then
    fSQLName := RawUTF8(copy(ClassName,2,maxInt)) else
    fSQLName := aFunctionName;
end;

function TSQLDataBaseSQLFunction.CreateFunction(DB: TSQLite3DB): Integer;
begin
  if self<>nil then 
    result := sqlite3.create_function(DB,pointer(fSQLName),
      FunctionParametersCount,SQLITE_ANY,self,fInternalFunction,nil,nil) else





    result := SQLITE_ERROR;
end;


{ TSQLDataBaseSQLFunctionDynArray }

procedure InternalSQLFunctionDynArrayBlob(Context: TSQLite3FunctionContext;
................................................................................

procedure TSQLStatementCached.Init(aDB: TSQLite3DB);
begin
  Caches.Init(TypeInfo(TSQLStatementCacheDynArray),Cache,nil,nil,nil,@Count);
  DB := aDB;
end;

function TSQLStatementCached.Prepare(const GenericSQL: RawUTF8;
  WasPrepared: PBoolean): PSQLRequest;
var added: boolean;
    ndx: integer;
    Timer: TPrecisionTimer;
begin
  ndx := Caches.FindHashedForAdding(GenericSQL,added);
  with Cache[ndx] do begin
    if added then begin
      Timer.Start;
      StatementSQL := GenericSQL;
      Statement.Prepare(DB,GenericSQL);
      if WasPrepared<>nil then
        WasPrepared^ := true;
    end else begin
      //Statement.BindReset; // slow down the process, and is not mandatory
      Statement.Reset;
      if WasPrepared<>nil then
        WasPrepared^ := false;
    end;
    result := @Statement;
  end;
end;

procedure TSQLStatementCached.ReleaseAllDBStatements;
var i: integer;

    /// release used instances and memory
    procedure CleanUp; override;
  published
    /// direct LZ77 deflate/inflate functions
    procedure InMemoryCompression;
    /// .gzip archive handling
    procedure GZIPFormat;
    {$ifdef MSWINDOWS}
    /// .zip archive handling
    procedure ZIPFormat;
    {$endif}
    /// SynLZO internal format
    procedure _SynLZO;
    /// SynLZ internal format
    procedure _SynLZ;
................................................................................
    Check(T.AddField('bool',tftBoolean)=nil);
    Check(T.AddField('double',tftDouble)<>nil);
    Check(T.AddField('varint',tftVarUInt32)<>nil);
    Check(T.AddField('text',tftUTF8,[tfoUnique])<>nil);
    Check(T.AddField('ansi',tftWinAnsi,[])<>nil);
    Check(T.AddField('currency',tftCurrency)<>nil);
    Test;
    FN := ChangeFileExt(paramstr(0),'.syntable');
    DeleteFile(FN);
    W := TFileBufferWriter.Create(FN); // manual storage of TSynTable header
    try
      T.SaveTo(W);
      W.Flush;
    finally
      W.Free;
................................................................................
    fFileVersions: TFVs;
    class function FVReader(P: PUTF8Char; var aValue;
      out aValid: Boolean): PUTF8Char;
    class procedure FVWriter(const aWriter: TTextWriter; const aValue);
    class function FVReader2(P: PUTF8Char; var aValue;
      out aValid: Boolean): PUTF8Char;
    class procedure FVWriter2(const aWriter: TTextWriter; const aValue);
    {$ifdef MSWINDOWS}
    class function FVClassReader(const aValue: TObject; aFrom: PUTF8Char;
      var aValid: Boolean; aOptions: TJSONToObjectOptions): PUTF8Char;
    class procedure FVClassWriter(const aSerializer: TJSONSerializer;
      aValue: TObject; aOptions: TTextWriterWriteObjectOptions);
    {$endif}
  published
    property Ints: TIntegerDynArray read fInts write fInts;
    property TimeLog: TTimeLogDynArray read fTimeLog write fTimeLog;
    property FileVersion: TFVs read fFileVersions write fFileVersions;
  end;


................................................................................
class procedure TCollTstDynArray.FVWriter2(const aWriter: TTextWriter; const aValue);
var V: TFV absolute aValue;
begin
  aWriter.AddJSONEscape(['Major',V.Major,'Minor',V.Minor,'Release',V.Release,
    'Build',V.Build,'Main',V.Main,'Detailed',V.Detailed]);
end;

{$ifdef MSWINDOWS}

class function TCollTstDynArray.FVClassReader(const aValue: TObject; aFrom: PUTF8Char;
  var aValid: Boolean; aOptions: TJSONToObjectOptions): PUTF8Char;
var V: TFileVersion absolute aValue;
    Values: TPUtf8CharDynArray;
begin // '{"Major":2,"Minor":2002,"Release":3002,"Build":4002,"Main":"2","BuildDateTime":"1911-03-15"}'
  result := JSONDecode(aFrom,['Major','Minor','Release','Build','Main','BuildDateTime'],Values);
  aValid := (result<>nil);
................................................................................
  aValue: TObject; aOptions: TTextWriterWriteObjectOptions);
var V: TFileVersion absolute aValue;
begin
  aSerializer.AddJSONEscape(['Major',V.Major,'Minor',V.Minor,'Release',V.Release,
    'Build',V.Build,'Main',V.Main,'BuildDateTime',DateTimeToIso8601Text(V.BuildDateTime)]);
end;

{$endif MSWINDOWS}


{ TCollTests }

function TCollTests.Add: TCollTest;
begin
  result := inherited Add as TCollTest;
end;
................................................................................
      Check(Main=IntToStr(i));
      Check(Detailed=IntToStr(i+1000));
    end;
  finally
    CA.Free;
  end;
end;
{$ifdef MSWINDOWS}
procedure TFileVersionTest(Full: boolean);
var V,F: TFileVersion;
    J: RawUTF8;
    i: integer;
    Valid: boolean;
begin
  V := TFileVersion.Create('',0);
  F := TFileVersion.Create('',0);
  try
    for i := 1 to 1000 do begin
      if Full then begin
        V.Major := i;
        V.Minor := i+2000;
        V.Release := i+3000;
        V.Build := i+4000;
................................................................................
      CheckSame(V.BuildDateTime,F.BuildDateTime);
    end;
  finally
    F.Free;
    V.Free;
  end;
end;
{$endif}
{$endif}
{$endif}
procedure ABCD;
begin
  Check(Parser.Root.NestedProperty[0].PropertyName='A');
  Check(Parser.Root.NestedProperty[0].PropertyType=ptInteger);
  Check(Parser.Root.NestedProperty[1].PropertyName='B');
................................................................................
  TTextWriter.RegisterCustomJSONSerializer(TypeInfo(TFVs),
    TCollTstDynArray.FVReader,TCollTstDynArray.FVWriter);
  TCollTstDynArrayTest;
  TTextWriter.RegisterCustomJSONSerializer(TypeInfo(TFVs),
    TCollTstDynArray.FVReader2,TCollTstDynArray.FVWriter2);
  TCollTstDynArrayTest;
  // (custom) class serialization
  {$ifdef MSWINDOWS}
  TFileVersionTest(false);
  TJSONSerializer.RegisterCustomSerializer(TFileVersion,
    TCollTstDynArray.FVClassReader,TCollTstDynArray.FVClassWriter);
  TFileVersionTest(true);
  TJSONSerializer.RegisterCustomSerializer(TFileVersion,nil,nil);
  TFileVersionTest(false);
  {$endif MSWINDOWS}
{$endif DELPHI5OROLDER}
{$endif LVCL}
  // test TJSONRecordTextDefinition parsing
  Parser := TJSONRecordTextDefinition.FromCache(nil,'Int: double');
  Check(Length(Parser.Root.NestedProperty)=1);
  Check(Parser.Root.NestedProperty[0].PropertyName='Int');
  Check(Parser.Root.NestedProperty[0].PropertyType=ptDouble);
................................................................................
var comp: Integer;
    tmp: RawByteString;
begin
  Check(CRC32string('TestCRC32')=$2CB8CDF3);
  tmp := RawByteString(Ident);
  for comp := 0 to 9 do
    Check(UnCompressString(CompressString(tmp,False,comp))=tmp);
  Data := StringFromFile(ParamStr(0));
  Check(UnCompressString(CompressString(Data,False,6))=Data);
end;


{$ifdef MSWINDOWS}

procedure TTestCompression.ZipFormat;
var FN: TFileName;

    S: TRawByteStringStream;
procedure Test(Z: TZipRead; aCount: integer);
var i: integer;
    tmp: RawByteString;
    crc: Cardinal;
begin
  with Z do
................................................................................
    i := NameToIndex('REp2\ident.gz');
    Check(i=1);
    crc := crc32(0,M.Memory,M.Position);
    Check(Entry[i].infoLocal^.zcrc32=crc);
    tmp := UnZip(i);
    Check(tmp<>'');
    Check(crc32(0,pointer(tmp),length(tmp))=crc);
    i := NameToIndex(ExtractFileName(paramstr(0)));
    Check(i=2);
    Check(UnZip(i)=Data);
    Check(Entry[i].infoLocal^.zcrc32=crc32(0,pointer(Data),length(Data)));
    i := NameToIndex('REp2\ident2.gz');
    Check(i=3);
    Check(Entry[i].infoLocal^.zcrc32=crc);
    tmp := UnZip(i);
................................................................................
  with Z do
  try
    AddDeflated('rep1\one.exe',pointer(Data),length(Data));
    Check(Count=1);
    AddDeflated('rep2\ident.gz',M.Memory,M.Position);
    Check(Count=2);
    if Z is TZipWrite then
      TZipWrite(Z).AddDeflated(ParamStr(0)) else
      Z.AddDeflated(ExtractFileName(paramstr(0)),pointer(Data),length(Data));
    Check(Count=3,'direct zip file');
    AddStored('rep2\ident2.gz',M.Memory,M.Position);
    Check(Count=4);
  finally
    Free;
  end;
end;
begin

  FN := ChangeFileExt(paramstr(0),'.zip');
  Prepare(TZipWrite.Create(FN));
  Test(TZipRead.Create(FN),4);
  S := TRawByteStringStream.Create;
  try
    Prepare(TZipWriteToStream.Create(S));
    Test(TZipRead.Create(pointer(S.DataString),length(S.DataString)),4);
  finally
................................................................................
  finally
    Free;
  end;
  Test(TZipRead.Create(FN),5);
  DeleteFile(FN);
end;

{$endif MSWINDOWS}

procedure TTestCompression._SynLZO;
var s,t: AnsiString;
    i: integer;
begin
  for i := 0 to 1000 do begin
    t := RandomString(i*8);
................................................................................
  Value[10] := #$E9;
  Value[16] := #$E7;
  Value[17] := #$E0;
  Check(not IsBase64(Value));
  Check(Base64Encode(Value)=Value64);
  Check(BinToBase64(Value)=Value64);
  Check(IsBase64(Value64));
  tmp := StringFromFile(paramstr(0));
  b64 := Base64Encode(tmp);
  Check(IsBase64(b64));
  Check(Base64Decode(b64)=tmp);
  Check(BinToBase64(tmp)=b64);
  Check(Base64ToBin(b64)=tmp);
  tmp := '';
  for i := 1 to 1998 do begin
................................................................................
        WS := 'Texte accentue n.'+IntToString(i);
        PWordArray(WS)^[13] := 233;
        PWordArray(WS)^[16] := 176;
        Canvas.TextOutW(100,y,pointer(WS));
        dec(y,9+i);
      end;
      SaveToStream(MS,FIXED_DATE);
      //MS.SaveToFile(ChangeFileExt(paramstr(0),'.pdf'));
      Check(Hash32(MS.Memory,MS.Position)=Hash[embed]);
      if not embed then begin
        if CharSet<>ANSI_CHARSET then
          break; // StandardFontsReplace will work only with ANSI code page
        NewDoc;
        MS.Clear;
      end;
................................................................................
      finally
        MF.Free;
      end;
      MS.Clear;
      SaveToStream(MS,FIXED_DATE);
      // force constant Arial,Bold and Tahoma FontBBox
      SetString(s,PAnsiChar(MS.Memory),MS.Position);
      MS.SaveToFile(ChangeFileExt(paramstr(0),'.pdf'));
      if (GetACP<>1252) {$ifdef CPU64}or true{$endif} then
        Check(length(s)>6500) else begin
        i := PosEx('/FontBBox[',s);
        if CheckFailed(i=5580) then exit;
        fillchar(s[i],32,32);
        j := PosEx('/FontBBox[',s);
        if CheckFailed(j=5910) then exit;
................................................................................


{ TServicePerThread }

constructor TServicePerThread.Create;
begin
  inherited;

  fThreadIDAtCreation := {$ifdef MSWINDOWS}Windows.{$else}SynCommons.{$endif}GetCurrentThreadID;
end;

function TServicePerThread.GetCurrentThreadID: cardinal;
begin
  result := {$ifdef MSWINDOWS}Windows.{$else}SynCommons.{$endif}GetCurrentThreadID;
  with PServiceRunningContext(@ServiceContext)^ do
    if Request<>nil then
................................................................................
    Ints[1] := i2;
    SetLength(Str2,3);
    Str2[0] := 'ABC';
    Str2[1] := 'DEF';
    Str2[2] := 'GHIJK';
    fillchar(Rec1,sizeof(Rec1),0);
    Rec1.Features := [vtTransaction,vtSavePoint];
    {$ifdef MSWINDOWS}
    Rec1.FileExtension := ExeVersion.ProgramFileName;
    {$endif}
    Rec2.ID := i1;
    Rec2.TimeStamp64 := c;
    Rec2.JSON := 'abc';
    RecRes := I.ComplexCall(Ints,Strs1,Str2,Rec1,Rec2,n1,n2);
    Check(length(Str2)=4);
    Check(Str2[0]='ABC');
    Check(Str2[1]='DEF');
    Check(Str2[2]='GHIJK');
    Check(Str2[3]='one,two,three');
    Check(Rec1.Features=[vtTransaction,vtSavePoint]);
    {$ifdef MSWINDOWS}
    Check(Rec1.FileExtension=ExeVersion.ProgramFileName);
    {$endif}
    Check(Rec2.ID=i1+1);
    Check(Rec2.TimeStamp64=c-1);
    Check(Rec2.JSON=IntegerDynArrayToCSV(Ints,length(Ints)));
    Check(RecRes.ID=i1);
    Check(RecRes.TimeStamp64=c);
    Check(RecRes.JSON=StringToUTF8(Rec1.FileExtension));
    CheckSame(n1,n2);

    /// release used instances and memory
    procedure CleanUp; override;
  published
    /// direct LZ77 deflate/inflate functions
    procedure InMemoryCompression;
    /// .gzip archive handling
    procedure GZIPFormat;
    {$ifndef LINUX}
    /// .zip archive handling
    procedure ZIPFormat;
    {$endif}
    /// SynLZO internal format
    procedure _SynLZO;
    /// SynLZ internal format
    procedure _SynLZ;
................................................................................
    Check(T.AddField('bool',tftBoolean)=nil);
    Check(T.AddField('double',tftDouble)<>nil);
    Check(T.AddField('varint',tftVarUInt32)<>nil);
    Check(T.AddField('text',tftUTF8,[tfoUnique])<>nil);
    Check(T.AddField('ansi',tftWinAnsi,[])<>nil);
    Check(T.AddField('currency',tftCurrency)<>nil);
    Test;
    FN := ChangeFileExt(ExeVersion.ProgramFileName,'.syntable');
    DeleteFile(FN);
    W := TFileBufferWriter.Create(FN); // manual storage of TSynTable header
    try
      T.SaveTo(W);
      W.Flush;
    finally
      W.Free;
................................................................................
    fFileVersions: TFVs;
    class function FVReader(P: PUTF8Char; var aValue;
      out aValid: Boolean): PUTF8Char;
    class procedure FVWriter(const aWriter: TTextWriter; const aValue);
    class function FVReader2(P: PUTF8Char; var aValue;
      out aValid: Boolean): PUTF8Char;
    class procedure FVWriter2(const aWriter: TTextWriter; const aValue);

    class function FVClassReader(const aValue: TObject; aFrom: PUTF8Char;
      var aValid: Boolean; aOptions: TJSONToObjectOptions): PUTF8Char;
    class procedure FVClassWriter(const aSerializer: TJSONSerializer;
      aValue: TObject; aOptions: TTextWriterWriteObjectOptions);

  published
    property Ints: TIntegerDynArray read fInts write fInts;
    property TimeLog: TTimeLogDynArray read fTimeLog write fTimeLog;
    property FileVersion: TFVs read fFileVersions write fFileVersions;
  end;


................................................................................
class procedure TCollTstDynArray.FVWriter2(const aWriter: TTextWriter; const aValue);
var V: TFV absolute aValue;
begin
  aWriter.AddJSONEscape(['Major',V.Major,'Minor',V.Minor,'Release',V.Release,
    'Build',V.Build,'Main',V.Main,'Detailed',V.Detailed]);
end;



class function TCollTstDynArray.FVClassReader(const aValue: TObject; aFrom: PUTF8Char;
  var aValid: Boolean; aOptions: TJSONToObjectOptions): PUTF8Char;
var V: TFileVersion absolute aValue;
    Values: TPUtf8CharDynArray;
begin // '{"Major":2,"Minor":2002,"Release":3002,"Build":4002,"Main":"2","BuildDateTime":"1911-03-15"}'
  result := JSONDecode(aFrom,['Major','Minor','Release','Build','Main','BuildDateTime'],Values);
  aValid := (result<>nil);
................................................................................
  aValue: TObject; aOptions: TTextWriterWriteObjectOptions);
var V: TFileVersion absolute aValue;
begin
  aSerializer.AddJSONEscape(['Major',V.Major,'Minor',V.Minor,'Release',V.Release,
    'Build',V.Build,'Main',V.Main,'BuildDateTime',DateTimeToIso8601Text(V.BuildDateTime)]);
end;




{ TCollTests }

function TCollTests.Add: TCollTest;
begin
  result := inherited Add as TCollTest;
end;
................................................................................
      Check(Main=IntToStr(i));
      Check(Detailed=IntToStr(i+1000));
    end;
  finally
    CA.Free;
  end;
end;

procedure TFileVersionTest(Full: boolean);
var V,F: TFileVersion;
    J: RawUTF8;
    i: integer;
    Valid: boolean;
begin
  V := TFileVersion.Create('',0,0,0);
  F := TFileVersion.Create('',0,0,0);
  try
    for i := 1 to 1000 do begin
      if Full then begin
        V.Major := i;
        V.Minor := i+2000;
        V.Release := i+3000;
        V.Build := i+4000;
................................................................................
      CheckSame(V.BuildDateTime,F.BuildDateTime);
    end;
  finally
    F.Free;
    V.Free;
  end;
end;

{$endif}
{$endif}
procedure ABCD;
begin
  Check(Parser.Root.NestedProperty[0].PropertyName='A');
  Check(Parser.Root.NestedProperty[0].PropertyType=ptInteger);
  Check(Parser.Root.NestedProperty[1].PropertyName='B');
................................................................................
  TTextWriter.RegisterCustomJSONSerializer(TypeInfo(TFVs),
    TCollTstDynArray.FVReader,TCollTstDynArray.FVWriter);
  TCollTstDynArrayTest;
  TTextWriter.RegisterCustomJSONSerializer(TypeInfo(TFVs),
    TCollTstDynArray.FVReader2,TCollTstDynArray.FVWriter2);
  TCollTstDynArrayTest;
  // (custom) class serialization

  TFileVersionTest(false);
  TJSONSerializer.RegisterCustomSerializer(TFileVersion,
    TCollTstDynArray.FVClassReader,TCollTstDynArray.FVClassWriter);
  TFileVersionTest(true);
  TJSONSerializer.RegisterCustomSerializer(TFileVersion,nil,nil);
  TFileVersionTest(false);

{$endif DELPHI5OROLDER}
{$endif LVCL}
  // test TJSONRecordTextDefinition parsing
  Parser := TJSONRecordTextDefinition.FromCache(nil,'Int: double');
  Check(Length(Parser.Root.NestedProperty)=1);
  Check(Parser.Root.NestedProperty[0].PropertyName='Int');
  Check(Parser.Root.NestedProperty[0].PropertyType=ptDouble);
................................................................................
var comp: Integer;
    tmp: RawByteString;
begin
  Check(CRC32string('TestCRC32')=$2CB8CDF3);
  tmp := RawByteString(Ident);
  for comp := 0 to 9 do
    Check(UnCompressString(CompressString(tmp,False,comp))=tmp);
  Data := StringFromFile(ExeVersion.ProgramFileName);
  Check(UnCompressString(CompressString(Data,False,6))=Data);
end;


{$ifndef LINUX} // TZipRead not defined yet (use low-level file mapping WinAPI)

procedure TTestCompression.ZipFormat;
var FN: TFileName;
    ExeName: string;
    S: TRawByteStringStream;
procedure Test(Z: TZipRead; aCount: integer);
var i: integer;
    tmp: RawByteString;
    crc: Cardinal;
begin
  with Z do
................................................................................
    i := NameToIndex('REp2\ident.gz');
    Check(i=1);
    crc := crc32(0,M.Memory,M.Position);
    Check(Entry[i].infoLocal^.zcrc32=crc);
    tmp := UnZip(i);
    Check(tmp<>'');
    Check(crc32(0,pointer(tmp),length(tmp))=crc);
    i := NameToIndex(ExeName);
    Check(i=2);
    Check(UnZip(i)=Data);
    Check(Entry[i].infoLocal^.zcrc32=crc32(0,pointer(Data),length(Data)));
    i := NameToIndex('REp2\ident2.gz');
    Check(i=3);
    Check(Entry[i].infoLocal^.zcrc32=crc);
    tmp := UnZip(i);
................................................................................
  with Z do
  try
    AddDeflated('rep1\one.exe',pointer(Data),length(Data));
    Check(Count=1);
    AddDeflated('rep2\ident.gz',M.Memory,M.Position);
    Check(Count=2);
    if Z is TZipWrite then
      TZipWrite(Z).AddDeflated(ExeVersion.ProgramFileName) else
      Z.AddDeflated(ExeName,pointer(Data),length(Data));
    Check(Count=3,'direct zip file');
    AddStored('rep2\ident2.gz',M.Memory,M.Position);
    Check(Count=4);
  finally
    Free;
  end;
end;
begin
  ExeName := ExtractFileName(ExeVersion.ProgramFileName);
  FN := ChangeFileExt(ExeVersion.ProgramFileName,'.zip');
  Prepare(TZipWrite.Create(FN));
  Test(TZipRead.Create(FN),4);
  S := TRawByteStringStream.Create;
  try
    Prepare(TZipWriteToStream.Create(S));
    Test(TZipRead.Create(pointer(S.DataString),length(S.DataString)),4);
  finally
................................................................................
  finally
    Free;
  end;
  Test(TZipRead.Create(FN),5);
  DeleteFile(FN);
end;

{$endif LINUX}

procedure TTestCompression._SynLZO;
var s,t: AnsiString;
    i: integer;
begin
  for i := 0 to 1000 do begin
    t := RandomString(i*8);
................................................................................
  Value[10] := #$E9;
  Value[16] := #$E7;
  Value[17] := #$E0;
  Check(not IsBase64(Value));
  Check(Base64Encode(Value)=Value64);
  Check(BinToBase64(Value)=Value64);
  Check(IsBase64(Value64));
  tmp := StringFromFile(ExeVersion.ProgramFileName);
  b64 := Base64Encode(tmp);
  Check(IsBase64(b64));
  Check(Base64Decode(b64)=tmp);
  Check(BinToBase64(tmp)=b64);
  Check(Base64ToBin(b64)=tmp);
  tmp := '';
  for i := 1 to 1998 do begin
................................................................................
        WS := 'Texte accentue n.'+IntToString(i);
        PWordArray(WS)^[13] := 233;
        PWordArray(WS)^[16] := 176;
        Canvas.TextOutW(100,y,pointer(WS));
        dec(y,9+i);
      end;
      SaveToStream(MS,FIXED_DATE);
      //MS.SaveToFile(ChangeFileExt(ExeVersion.ProgramFileName,'.pdf'));
      Check(Hash32(MS.Memory,MS.Position)=Hash[embed]);
      if not embed then begin
        if CharSet<>ANSI_CHARSET then
          break; // StandardFontsReplace will work only with ANSI code page
        NewDoc;
        MS.Clear;
      end;
................................................................................
      finally
        MF.Free;
      end;
      MS.Clear;
      SaveToStream(MS,FIXED_DATE);
      // force constant Arial,Bold and Tahoma FontBBox
      SetString(s,PAnsiChar(MS.Memory),MS.Position);
      MS.SaveToFile(ChangeFileExt(ExeVersion.ProgramFileName,'.pdf'));
      if (GetACP<>1252) {$ifdef CPU64}or true{$endif} then
        Check(length(s)>6500) else begin
        i := PosEx('/FontBBox[',s);
        if CheckFailed(i=5580) then exit;
        fillchar(s[i],32,32);
        j := PosEx('/FontBBox[',s);
        if CheckFailed(j=5910) then exit;
................................................................................


{ TServicePerThread }

constructor TServicePerThread.Create;
begin
  inherited;
  fThreadIDAtCreation :=
    {$ifdef MSWINDOWS}Windows.{$else}SynCommons.{$endif}GetCurrentThreadID;
end;

function TServicePerThread.GetCurrentThreadID: cardinal;
begin
  result := {$ifdef MSWINDOWS}Windows.{$else}SynCommons.{$endif}GetCurrentThreadID;
  with PServiceRunningContext(@ServiceContext)^ do
    if Request<>nil then
................................................................................
    Ints[1] := i2;
    SetLength(Str2,3);
    Str2[0] := 'ABC';
    Str2[1] := 'DEF';
    Str2[2] := 'GHIJK';
    fillchar(Rec1,sizeof(Rec1),0);
    Rec1.Features := [vtTransaction,vtSavePoint];

    Rec1.FileExtension := ExeVersion.ProgramFileName;

    Rec2.ID := i1;
    Rec2.TimeStamp64 := c;
    Rec2.JSON := 'abc';
    RecRes := I.ComplexCall(Ints,Strs1,Str2,Rec1,Rec2,n1,n2);
    Check(length(Str2)=4);
    Check(Str2[0]='ABC');
    Check(Str2[1]='DEF');
    Check(Str2[2]='GHIJK');
    Check(Str2[3]='one,two,three');
    Check(Rec1.Features=[vtTransaction,vtSavePoint]);

    Check(Rec1.FileExtension=ExeVersion.ProgramFileName);

    Check(Rec2.ID=i1+1);
    Check(Rec2.TimeStamp64=c-1);
    Check(Rec2.JSON=IntegerDynArrayToCSV(Ints,length(Ints)));
    Check(RecRes.ID=i1);
    Check(RecRes.TimeStamp64=c);
    Check(RecRes.JSON=StringToUTF8(Rec1.FileExtension));
    CheckSame(n1,n2);

    C: TSynTestCase;
    ILog: IUnknown;
begin
  if TTextRec(fSaveToFile).Handle=0 then
    CreateSaveToFile;
  Color(ccLightCyan);
  Writeln(fSaveToFile,#13#10'   ',Ident,#13#10'  ',StringOfChar('-',length(Ident)+2));
{$ifdef MSWINDOWS}
  RunTimer.Start;
  ExeVersionRetrieve;
{$endif}
  C := nil;
  try
    // 1. register all test cases
    fTestCase.Clear;
    for m := 0 to Count-1 do begin
      C := pointer(m);
      fCurrentMethod := m;
................................................................................
      fFailed.AddObject(E.ClassName+': '+E.Message,C);
      writeln(fSaveToFile,#13#10'! Exception ',E.ClassName,
        ' raised with messsage:'#13#10'!  ',E.Message);
    end;
  end;
  Color(ccLightCyan);
  result := (fFailed.Count=0);
{$ifdef MSWINDOWS}
  Elapsed := #13#10#13#10'Time elapsed for all tests: '+RunTimer.Stop;
  if Exeversion.Version.Major<>0 then
    Version := #13#10'Software version tested: '+RawUTF8(Exeversion.Version.Detailed);
{$endif}
  Writeln(fSaveToFile,#13#10,Version,CustomVersions,
    #13#10'Generated with: ',GetDelphiCompilerVersion,' compiler', Elapsed,
    #13#10'Tests performed at ',DateTimeToStr(Now));
  if result then
    Color(ccWhite) else
    Color(ccLightRed);
  write(fSaveToFile,#13#10'Total assertions failed for all test suits:  ',

    C: TSynTestCase;
    ILog: IUnknown;
begin
  if TTextRec(fSaveToFile).Handle=0 then
    CreateSaveToFile;
  Color(ccLightCyan);
  Writeln(fSaveToFile,#13#10'   ',Ident,#13#10'  ',StringOfChar('-',length(Ident)+2));

  RunTimer.Start;


  C := nil;
  try
    // 1. register all test cases
    fTestCase.Clear;
    for m := 0 to Count-1 do begin
      C := pointer(m);
      fCurrentMethod := m;
................................................................................
      fFailed.AddObject(E.ClassName+': '+E.Message,C);
      writeln(fSaveToFile,#13#10'! Exception ',E.ClassName,
        ' raised with messsage:'#13#10'!  ',E.Message);
    end;
  end;
  Color(ccLightCyan);
  result := (fFailed.Count=0);

  Elapsed := #13#10#13#10'Time elapsed for all tests: '+RunTimer.Stop;
  if Exeversion.Version.Major<>0 then
    Version := #13#10'Software version tested: '+RawUTF8(Exeversion.Version.Detailed);

  Writeln(fSaveToFile,#13#10,Version,CustomVersions,
    #13#10'Generated with: ',GetDelphiCompilerVersion,' compiler', Elapsed,
    #13#10'Tests performed at ',DateTimeToStr(Now));
  if result then
    Color(ccWhite) else
    Color(ccLightRed);
  write(fSaveToFile,#13#10'Total assertions failed for all test suits:  ',

'1.18.901'

'1.18.902'