* synchronised with trunk till r41449

git-svn-id: branches/debug_eh@41450 -

.gitattributes

@@ -2307,6 +2307,7 @@ packages/fcl-db/src/sqldb/postgres/fpmake.pp svneol=native#text/plain
 packages/fcl-db/src/sqldb/postgres/pqconnection.pp svneol=native#text/plain
 packages/fcl-db/src/sqldb/postgres/pqeventmonitor.pp svneol=native#text/plain
 packages/fcl-db/src/sqldb/sqldb.pp svneol=native#text/plain
+packages/fcl-db/src/sqldb/sqldbini.pp svneol=native#text/plain
 packages/fcl-db/src/sqldb/sqldblib.pp svneol=native#text/plain
 packages/fcl-db/src/sqldb/sqlite/Makefile svneol=native#text/plain
 packages/fcl-db/src/sqldb/sqlite/Makefile.fpc svneol=native#text/plain
@@ -3318,6 +3319,16 @@ packages/fcl-web/examples/jsonrpc/extdirect/extdemo.lpr svneol=native#text/plain
 packages/fcl-web/examples/jsonrpc/extdirect/extdirect.in svneol=native#text/plain
 packages/fcl-web/examples/jsonrpc/extdirect/wmext.lfm svneol=native#text/plain
 packages/fcl-web/examples/jsonrpc/extdirect/wmext.pp svneol=native#text/plain
+packages/fcl-web/examples/restbridge/README.txt svneol=native#text/plain
+packages/fcl-web/examples/restbridge/delphiclient/frmmain.dfm svneol=native#text/plain
+packages/fcl-web/examples/restbridge/delphiclient/frmmain.pas svneol=native#text/plain
+packages/fcl-web/examples/restbridge/delphiclient/sqldbrestclient.dpr svneol=native#text/plain
+packages/fcl-web/examples/restbridge/delphiclient/sqldbrestclient.dproj svneol=native#text/plain
+packages/fcl-web/examples/restbridge/delphiclient/sqldbrestclient.res -text
+packages/fcl-web/examples/restbridge/demorestbridge.lpi svneol=native#text/plain
+packages/fcl-web/examples/restbridge/demorestbridge.pp svneol=native#text/plain
+packages/fcl-web/examples/restbridge/expenses-data.sql svneol=native#text/plain
+packages/fcl-web/examples/restbridge/expenses-pq.sql svneol=native#text/plain
 packages/fcl-web/examples/routing-session/routingsessiondemo.lpi svneol=native#text/plain
 packages/fcl-web/examples/routing-session/routingsessiondemo.lpr svneol=native#text/plain
 packages/fcl-web/examples/routing/README svneol=native#text/plain
@@ -3451,6 +3462,18 @@ packages/fcl-web/src/jsonrpc/fpextdirect.pp svneol=native#text/plain
 packages/fcl-web/src/jsonrpc/fpjsonrpc.pp svneol=native#text/plain
 packages/fcl-web/src/jsonrpc/readme.txt svneol=native#text/plain
 packages/fcl-web/src/jsonrpc/webjsonrpc.pp svneol=native#text/plain
+packages/fcl-web/src/restbridge/sqldbrestauth.pp svneol=native#text/plain
+packages/fcl-web/src/restbridge/sqldbrestauthini.pp svneol=native#text/plain
+packages/fcl-web/src/restbridge/sqldbrestbridge.pp svneol=native#text/plain
+packages/fcl-web/src/restbridge/sqldbrestcds.pp svneol=native#text/plain
+packages/fcl-web/src/restbridge/sqldbrestconst.pp svneol=native#text/plain
+packages/fcl-web/src/restbridge/sqldbrestcsv.pp svneol=native#text/plain
+packages/fcl-web/src/restbridge/sqldbrestdata.pp svneol=native#text/plain
+packages/fcl-web/src/restbridge/sqldbrestini.pp svneol=native#text/plain
+packages/fcl-web/src/restbridge/sqldbrestio.pp svneol=native#text/plain
+packages/fcl-web/src/restbridge/sqldbrestjson.pp svneol=native#text/plain
+packages/fcl-web/src/restbridge/sqldbrestschema.pp svneol=native#text/plain
+packages/fcl-web/src/restbridge/sqldbrestxml.pp svneol=native#text/plain
 packages/fcl-web/src/webdata/Makefile svneol=native#text/plain
 packages/fcl-web/src/webdata/Makefile.fpc svneol=native#text/plain
 packages/fcl-web/src/webdata/extjsjson.pp svneol=native#text/plain
@@ -16516,6 +16539,8 @@ tests/webtbs/tw35027.pp svneol=native#text/pascal
 tests/webtbs/tw35028.pp svneol=native#text/pascal
 tests/webtbs/tw3504.pp svneol=native#text/plain
 tests/webtbs/tw3506.pp svneol=native#text/plain
+tests/webtbs/tw35139.pp svneol=native#text/plain
+tests/webtbs/tw35139a.pp svneol=native#text/plain
 tests/webtbs/tw3523.pp svneol=native#text/plain
 tests/webtbs/tw3529.pp svneol=native#text/plain
 tests/webtbs/tw3531.pp svneol=native#text/plain

compiler/aarch64/ncpuset.pas

@@ -31,9 +31,9 @@ interface
     type
        taarch64casenode = class(tcgcasenode)
          protected
-           procedure optimizevalues(var max_linear_list: aint; var max_dist: aword);override;
+           procedure optimizevalues(var max_linear_list: int64; var max_dist: qword);override;
            function  has_jumptable: boolean;override;
-           procedure genjumptable(hp: pcaselabel ;min_, max_: aint);override;
+           procedure genjumptable(hp: pcaselabel ;min_, max_: int64);override;
        end;
 
 
@@ -56,7 +56,7 @@ implementation
 *****************************************************************************}
 
 
-    procedure taarch64casenode.optimizevalues(var max_linear_list: aint; var max_dist: aword);
+    procedure taarch64casenode.optimizevalues(var max_linear_list: int64; var max_dist: qword);
       begin
         max_linear_list:=10;
       end;
@@ -68,7 +68,7 @@ implementation
       end;
 
 
-    procedure taarch64casenode.genjumptable(hp: pcaselabel; min_, max_: aint);
+    procedure taarch64casenode.genjumptable(hp: pcaselabel; min_, max_: int64);
       var
         last: TConstExprInt;
         tablelabel: TAsmLabel;
@@ -80,7 +80,7 @@ implementation
 
       procedure genitem(list:TAsmList;t : pcaselabel);
         var
-          i : aint;
+          i : int64;
         begin
           if assigned(t^.less) then
             genitem(list,t^.less);

compiler/arm/cpubase.pas

@@ -418,8 +418,11 @@ unit cpubase;
           R_MMREGISTER:
             begin
               case s of
+                { records passed in MM registers }
+                OS_32,
                 OS_F32:
                   cgsize2subreg:=R_SUBFS;
+                OS_64,
                 OS_F64:
                   cgsize2subreg:=R_SUBFD;
                 else

compiler/arm/cpupara.pas

@@ -512,13 +512,11 @@ unit cpupara;
                            firstparaloc and
                            (paradef.alignment=8) then
                           begin
+                            hp.paraloc[side].Alignment:=8;
                             if (nextintreg in [RS_R1,RS_R3]) then
                               inc(nextintreg)
                             else if nextintreg>RS_R3 then
-                              begin
-                                stack_offset:=align(stack_offset,8);
-                                hp.paraloc[side].Alignment:=8;
-                              end;
+                              stack_offset:=align(stack_offset,8);
                           end;
                         if nextintreg<=RS_R3 then
                           begin

compiler/arm/narmset.pas

@@ -41,9 +41,9 @@ interface
        end;
 
       tarmcasenode = class(tcgcasenode)
-         procedure optimizevalues(var max_linear_list:aint;var max_dist:aword);override;
+         procedure optimizevalues(var max_linear_list:int64;var max_dist:qword);override;
          function  has_jumptable : boolean;override;
-         procedure genjumptable(hp : pcaselabel;min_,max_ : aint);override;
+         procedure genjumptable(hp : pcaselabel;min_,max_ : int64);override;
          procedure genlinearlist(hp : pcaselabel);override;
          procedure genjmptreeentry(p : pcaselabel;parentvalue : TConstExprInt);override;
       end;
@@ -136,7 +136,7 @@ implementation
                             TARMCASENODE
 *****************************************************************************}
 
-    procedure tarmcasenode.optimizevalues(var max_linear_list:aint;var max_dist:aword);
+    procedure tarmcasenode.optimizevalues(var max_linear_list:int64;var max_dist:qword);
       begin
         inc(max_linear_list,2)
       end;
@@ -148,7 +148,7 @@ implementation
       end;
 
 
-    procedure tarmcasenode.genjumptable(hp : pcaselabel;min_,max_ : aint);
+    procedure tarmcasenode.genjumptable(hp : pcaselabel;min_,max_ : int64);
       var
         last : TConstExprInt;
         tmpreg,
@@ -161,22 +161,30 @@ implementation
 
         procedure genitem(list:TAsmList;t : pcaselabel);
           var
-            i : aint;
+            i : int64;
           begin
             if assigned(t^.less) then
               genitem(list,t^.less);
             { fill possible hole }
-            for i:=last.svalue+1 to t^._low.svalue-1 do
-              if cs_create_pic in current_settings.moduleswitches then
-                list.concat(Tai_const.Create_rel_sym_offset(aitconst_ptr,piclabel,elselabel,picoffset))
-              else
-                list.concat(Tai_const.Create_sym(elselabel));
-            for i:=t^._low.svalue to t^._high.svalue do
-              if cs_create_pic in current_settings.moduleswitches then
-                list.concat(Tai_const.Create_rel_sym_offset(aitconst_ptr,piclabel,blocklabel(t^.blockid),picoffset))
-              else
-                list.concat(Tai_const.Create_sym(blocklabel(t^.blockid)));
-            last:=t^._high.svalue;
+            i:=last+1;
+            while i<=t^._low-1 do
+              begin
+                if cs_create_pic in current_settings.moduleswitches then
+                  list.concat(Tai_const.Create_rel_sym_offset(aitconst_ptr,piclabel,elselabel,picoffset))
+                else
+                  list.concat(Tai_const.Create_sym(elselabel));
+                i:=i+1;
+              end;
+            i:=t^._low;
+            while i<=t^._high do
+              begin
+                if cs_create_pic in current_settings.moduleswitches then
+                  list.concat(Tai_const.Create_rel_sym_offset(aitconst_ptr,piclabel,blocklabel(t^.blockid),picoffset))
+                else
+                  list.concat(Tai_const.Create_sym(blocklabel(t^.blockid)));
+                i:=i+1;
+              end;
+            last:=t^._high;
             if assigned(t^.greater) then
               genitem(list,t^.greater);
           end;

compiler/i386/n386set.pas

@@ -31,7 +31,7 @@ interface
 
     type
       ti386casenode = class(tx86casenode)
-         procedure optimizevalues(var max_linear_list:aint;var max_dist:aword);override;
+         procedure optimizevalues(var max_linear_list:int64;var max_dist:qword);override;
       end;
 
 
@@ -44,7 +44,7 @@ implementation
                             TI386CASENODE
 *****************************************************************************}
 
-    procedure ti386casenode.optimizevalues(var max_linear_list:aint;var max_dist:aword);
+    procedure ti386casenode.optimizevalues(var max_linear_list:int64;var max_dist:qword);
       begin
         { a jump table crashes the pipeline! }
         if current_settings.optimizecputype=cpu_386 then

compiler/llvm/agllvm.pas

@@ -222,9 +222,9 @@ implementation
               { escape dollars }
               '$':
                  result:=result+'$$';
-              { ^ is used as placeholder for a single dollar (reference to
+              { ` is used as placeholder for a single dollar (reference to
                  argument to the inline assembly) }
-              '^':
+              '`':
                  result:=result+'$';
               #0..#31,
               #127..#255,

compiler/llvm/llvmdef.pas

@@ -118,7 +118,8 @@ implementation
     fmodule,
     symtable,symsym,
     llvmsym,hlcgobj,
-    defutil,blockutl,cgbase,paramgr;
+    defutil,blockutl,cgbase,paramgr,
+    cpubase;
 
 
 {******************************************************************
@@ -667,9 +668,12 @@ implementation
 
     procedure llvmaddencodedparaloctype(hp: tparavarsym; proccalloption: tproccalloption; withparaname, withattributes: boolean; var first: boolean; var encodedstr: TSymStr);
       var
+        para: PCGPara;
         paraloc: PCGParaLocation;
+        side: tcallercallee;
         signext: tllvmvalueextension;
         usedef: tdef;
+        firstloc: boolean;
       begin
         if (proccalloption in cdecl_pocalls) and
            is_array_of_const(hp.vardef) then
@@ -681,20 +685,17 @@ implementation
             encodedstr:=encodedstr+'...';
             exit
           end;
-        if withparaname then
-          begin
-            { don't add parameters that don't take up registers or stack space;
-              clang doesn't either and some LLVM backends don't support them }
-            if hp.paraloc[calleeside].isempty then
-              exit;
-            paraloc:=hp.paraloc[calleeside].location
-          end
+        if not withparaname then
+          side:=callerside
         else
-          begin
-            if hp.paraloc[callerside].isempty then
-              exit;
-            paraloc:=hp.paraloc[callerside].location;
-          end;
+          side:=calleeside;
+        { don't add parameters that don't take up registers or stack space;
+          clang doesn't either and some LLVM backends don't support them }
+        if hp.paraloc[side].isempty then
+          exit;
+        para:[email protected][side];
+        paraloc:=para^.location;
+        firstloc:=true;
         repeat
           usedef:=paraloc^.def;
           llvmextractvalueextinfo(hp.vardef,usedef,signext);
@@ -723,15 +724,22 @@ implementation
 {$endif aarch64}
               if withattributes then
                  if first then
-                   encodedstr:=encodedstr+' sret'
-                 else { we can add some other attributes to optimise things,}
+                   encodedstr:=encodedstr+' sret noalias nocapture'
+                 else
                    encodedstr:=encodedstr+' noalias nocapture';
             end
           else if not paramanager.push_addr_param(hp.varspez,hp.vardef,proccalloption) and
              llvmbyvalparaloc(paraloc) then
             begin
               if withattributes then
-                encodedstr:=encodedstr+'* byval'
+                begin
+                  encodedstr:=encodedstr+'* byval';
+                  if firstloc and
+                     (para^.alignment<>std_param_align) then
+                    begin
+                      encodedstr:=encodedstr+' align '+tostr(para^.alignment);
+                    end;
+                end
               else
                 encodedstr:=encodedstr+'*';
             end
@@ -751,7 +759,7 @@ implementation
                     vs_value,
                     vs_const:
                       begin
-                        encodedstr:=encodedstr+' nocapture dereferenceable('
+                        encodedstr:=encodedstr+' dereferenceable('
                       end;
                     vs_var,
                     vs_out,
@@ -759,7 +767,7 @@ implementation
                       begin
                         { while normally these are not nil, it is technically possible
                           to pass nil via ptrtype(nil)^ }
-                        encodedstr:=encodedstr+' nocapture dereferenceable_or_null('
+                        encodedstr:=encodedstr+' dereferenceable_or_null('
                       end;
                     else
                       internalerror(2018120801);
@@ -777,6 +785,7 @@ implementation
               encodedstr:=encodedstr+' '+llvmasmsymname(paraloc^.llvmloc.sym);
             end;
           paraloc:=paraloc^.next;
+          firstloc:=false;
           first:=false;
         until not assigned(paraloc);
       end;
@@ -930,6 +939,7 @@ implementation
         retloc: pcgparalocation;
         usedef: tdef;
         valueext: tllvmvalueextension;
+        paraslots,
         i: longint;
         sizeleft: asizeint;
       begin
@@ -1000,7 +1010,19 @@ implementation
               end
             end
           else
-            retdeflist[i]:=retloc^.def;
+            begin
+              if retloc^.def.typ<>floatdef then
+                begin
+                  paraslots:=sizeleft div cgpara.Alignment;
+                  if (paraslots>1) and
+                     ((paraslots*cgpara.Alignment)=sizeleft) then
+                    retdeflist[i]:=carraydef.getreusable(cgsize_orddef(int_cgsize(cgpara.Alignment)),paraslots)
+                  else
+                    retdeflist[i]:=retloc^.def;
+                end
+              else
+                retdeflist[i]:=retloc^.def;
+            end;
           inc(i);
           retloc:=retloc^.next;
         until not assigned(retloc);

compiler/llvm/nllvmbas.pas

@@ -110,11 +110,11 @@ interface
 
     function tllvmasmnode.getllvmasmparasym(sym: tabstractnormalvarsym): tasmsymbol;
       begin
-        { these have to be transformed from ^nr into into $nr; we use ^ because
+        { these have to be transformed from `nr into into $nr; we use ` because
           we also have to double all other occurrences of '$' in the assembly
           code, and we can't differentiate between these and other '$'s in
           agllvm }
-        result:=current_asmdata.RefAsmSymbol('^'+tostr(getllvmasmopindexforsym(sym)),AT_DATA,false);
+        result:=current_asmdata.RefAsmSymbol('`'+tostr(getllvmasmopindexforsym(sym)),AT_DATA,false);
       end;
 
 

compiler/mips/ncpuset.pas

@@ -33,9 +33,9 @@ uses
 type
   tcpucasenode = class(tcgcasenode)
   protected
-    procedure optimizevalues(var max_linear_list: aint; var max_dist: aword); override;
+    procedure optimizevalues(var max_linear_list: int64; var max_dist: qword); override;
     function has_jumptable: boolean; override;
-    procedure genjumptable(hp: pcaselabel; min_, max_: aint); override;
+    procedure genjumptable(hp: pcaselabel; min_, max_: int64); override;
   end;
 
 
@@ -50,7 +50,7 @@ uses
   cgbase, cgutils, cgobj,
   defutil,procinfo;
 
-procedure tcpucasenode.optimizevalues(var max_linear_list: aint; var max_dist: aword);
+procedure tcpucasenode.optimizevalues(var max_linear_list: int64; var max_dist: qword);
 begin
   { give the jump table a higher priority }
   max_dist := (max_dist * 3) div 2;
@@ -63,7 +63,7 @@ begin
 end;
 
 
-procedure tcpucasenode.genjumptable(hp: pcaselabel; min_, max_: aint);
+procedure tcpucasenode.genjumptable(hp: pcaselabel; min_, max_: int64);
 var
   table: tasmlabel;
   last:  TConstExprInt;
@@ -75,15 +75,23 @@ var
 
   procedure genitem(t: pcaselabel);
   var
-    i: aint;
+    i: TConstExprInt;
   begin
     if assigned(t^.less) then
       genitem(t^.less);
     { fill possible hole }
-    for i := last.svalue+1 to t^._low.svalue-1 do
-      jumpSegment.concat(Tai_const.Create_type_sym(labeltyp,elselabel));
-    for i := t^._low.svalue to t^._high.svalue do
-      jumpSegment.concat(Tai_const.Create_type_sym(labeltyp,blocklabel(t^.blockid)));
+    i:=last+1;
+    while i<=t^._low-1 do
+      begin
+        jumpSegment.concat(Tai_const.Create_type_sym(labeltyp,elselabel));
+        i:=i+1;
+      end;
+    i:= t^._low;
+    while i<=t^._high do
+      begin
+        jumpSegment.concat(Tai_const.Create_type_sym(labeltyp,blocklabel(t^.blockid)));
+        i:=i+1;
+      end;
     last := t^._high;
     if assigned(t^.greater) then
       genitem(t^.greater);

compiler/msg/errore.msg

@@ -1594,7 +1594,10 @@ parser_e_only_static_members_via_object_type=03349_E_Only static methods and sta
 %   TObj.test;
 % \end{verbatim}
 % \var{test} is not a static method and hence cannot be called through a type, but only using an instance.
-%
+parse_e_callthrough_varargs=03350_E_Cannot redeclare C-style variadic function "$1" as external on this platform; make its first declaration already external
+% If a function is declared normally in the interface or as a forward declaration, and then later as external, the compiler
+% must generate a stub that calls the external function. Due to code generation limitations, this cannot be done on some
+% platforms. Even on platforms where it is supported, this is quite inefficient.
 %
 % \end{description}
 %

compiler/msgidx.inc

@@ -460,6 +460,7 @@ const
   parser_w_operator_overloaded_hidden_3=03347;
   parser_e_threadvar_must_be_class=03348;
   parser_e_only_static_members_via_object_type=03349;
+  parse_e_callthrough_varargs=03350;
   type_e_mismatch=04000;
   type_e_incompatible_types=04001;
   type_e_not_equal_types=04002;
@@ -1107,9 +1108,9 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 82796;
+  MsgTxtSize = 82926;
 
   MsgIdxMax : array[1..20] of longint=(
-    28,106,350,126,99,59,142,34,221,67,
+    28,106,351,126,99,59,142,34,221,67,
     62,20,30,1,1,1,1,1,1,1
   );

compiler/ncgset.pas

@@ -82,9 +82,9 @@ interface
           function GetBranchLabel(Block: TNode; out _Label: TAsmLabel): Boolean;
 
           function  blocklabel(id:longint):tasmlabel;
-          procedure optimizevalues(var max_linear_list:aint;var max_dist:aword);virtual;
+          procedure optimizevalues(var max_linear_list:int64;var max_dist:qword);virtual;
           function  has_jumptable : boolean;virtual;
-          procedure genjumptable(hp : pcaselabel;min_,max_ : aint); virtual;
+          procedure genjumptable(hp : pcaselabel;min_,max_ : int64); virtual;
           procedure genlinearlist(hp : pcaselabel); virtual;
           procedure genlinearcmplist(hp : pcaselabel); virtual;
 
@@ -613,7 +613,7 @@ implementation
       end;
 
 
-    procedure tcgcasenode.optimizevalues(var max_linear_list:aint;var max_dist:aword);
+    procedure tcgcasenode.optimizevalues(var max_linear_list:int64;var max_dist:qword);
       begin
         { no changes by default }
       end;
@@ -626,7 +626,7 @@ implementation
       end;
 
 
-    procedure tcgcasenode.genjumptable(hp : pcaselabel;min_,max_ : aint);
+    procedure tcgcasenode.genjumptable(hp : pcaselabel;min_,max_ : int64);
       begin
         internalerror(200209161);
       end;
@@ -827,7 +827,7 @@ implementation
 {$endif}
 {$endif cpuhighleveltarget}
                   begin
-                     hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList, opsize, OC_EQ, aint(t^._low.svalue),hregister, blocklabel(t^.blockid));
+                     hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList, opsize, OC_EQ, tcgint(t^._low),hregister, blocklabel(t^.blockid));
                   end;
                 { Reset last here, because we've only checked for one value and need to compare
                   for the next range both the lower and upper bound }
@@ -934,7 +934,7 @@ implementation
 {$endif}
 {$endif cpuhighleveltarget}
                        begin
-                        hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList, opsize, jmp_lt, aint(t^._low.svalue), hregister,
+                        hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList, opsize, jmp_lt, tcgint(t^._low), hregister,
                            elselabel);
                        end;
                   end;
@@ -1026,7 +1026,7 @@ implementation
 {$endif}
 {$endif cpuhighleveltarget}
                   begin
-                     hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList, opsize, jmp_le, aint(t^._high.svalue), hregister, blocklabel(t^.blockid));
+                     hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList, opsize, jmp_le, tcgint(t^._high.svalue), hregister, blocklabel(t^.blockid));
                   end;
 
                 last:=t^._high;
@@ -1165,8 +1165,8 @@ implementation
          distv,
          lv,hv,
          max_label: tconstexprint;
-         max_linear_list : aint;
-         max_dist : aword;
+         max_linear_list : int64;
+         max_dist : qword;
          ShortcutElse: Boolean;
       begin
          location_reset(location,LOC_VOID,OS_NO);

compiler/ppcgen/ngppcset.pas

@@ -31,9 +31,9 @@ interface
     type
        tgppccasenode = class(tcgcasenode)
          protected
-           procedure optimizevalues(var max_linear_list : aint; var max_dist : aword);override;
+           procedure optimizevalues(var max_linear_list : int64; var max_dist : qword);override;
            function  has_jumptable : boolean;override;
-           procedure genjumptable(hp : pcaselabel;min_,max_ : aint);override;
+           procedure genjumptable(hp : pcaselabel;min_,max_ : int64);override;
            procedure genlinearlist(hp : pcaselabel); override;
        end;
 
@@ -57,7 +57,7 @@ implementation
 *****************************************************************************}
 
 
-    procedure tgppccasenode.optimizevalues(var max_linear_list : aint; var max_dist : aword);
+    procedure tgppccasenode.optimizevalues(var max_linear_list : int64; var max_dist : qword);
     begin
       max_linear_list := 10;
     end;
@@ -69,7 +69,7 @@ implementation
       end;
 
 
-    procedure tgppccasenode.genjumptable(hp : pcaselabel;min_,max_ : aint);
+    procedure tgppccasenode.genjumptable(hp : pcaselabel;min_,max_ : int64);
       var
         table : tasmlabel;
         last : TConstExprInt;

compiler/psub.pas

@@ -2401,7 +2401,14 @@ implementation
                  if (not pd.forwarddef) and
                     (pd.hasforward) and
                     (proc_get_importname(pd)<>'') then
-                   call_through_new_name(pd,proc_get_importname(pd))
+                   begin
+                     { we cannot handle the callee-side of variadic functions (and
+                       even if we could, e.g. LLVM cannot call through to something
+                       else in that case) }
+                     if is_c_variadic(pd) then
+                       Message1(parse_e_callthrough_varargs,pd.fullprocname(false));
+                     call_through_new_name(pd,proc_get_importname(pd));
+                   end
                  else
 {$endif cpuhighleveltarget}
                    begin

compiler/riscv/nrvset.pas

@@ -31,9 +31,9 @@ interface
     type
        trvcasenode = class(tcgcasenode)
          protected
-           procedure optimizevalues(var max_linear_list : aint; var max_dist : aword);override;
+           procedure optimizevalues(var max_linear_list : int64; var max_dist : qword);override;
            function  has_jumptable : boolean;override;
-           procedure genjumptable(hp : pcaselabel;min_,max_ : aint);override;
+           procedure genjumptable(hp : pcaselabel;min_,max_ : int64);override;
        end;
 
 
@@ -56,7 +56,7 @@ implementation
 *****************************************************************************}
 
 
-    procedure trvcasenode.optimizevalues(var max_linear_list : aint; var max_dist : aword);
+    procedure trvcasenode.optimizevalues(var max_linear_list : int64; var max_dist : qword);
       begin
         max_linear_list := 3;
       end;
@@ -68,7 +68,7 @@ implementation
       end;
 
 
-    procedure trvcasenode.genjumptable(hp : pcaselabel;min_,max_ : aint);
+    procedure trvcasenode.genjumptable(hp : pcaselabel;min_,max_ : int64);
       var
         table : tasmlabel;
         last : TConstExprInt;

compiler/sparcgen/ncpuset.pas

@@ -34,9 +34,9 @@ unit ncpuset;
     type
        tcpucasenode = class(tcgcasenode)
          protected
-           procedure optimizevalues(var max_linear_list:aint;var max_dist:aword);override;
+           procedure optimizevalues(var max_linear_list:int64;var max_dist:qword);override;
            function has_jumptable : boolean;override;
-           procedure genjumptable(hp : pcaselabel;min_,max_ : aint);override;
+           procedure genjumptable(hp : pcaselabel;min_,max_ : int64);override;
        end;
 
 
@@ -50,7 +50,7 @@ unit ncpuset;
       cgbase,cgutils,cgobj,
       defutil,procinfo;
 
-    procedure tcpucasenode.optimizevalues(var max_linear_list:aint;var max_dist:aword);
+    procedure tcpucasenode.optimizevalues(var max_linear_list:int64;var max_dist:qword);
       begin
         { give the jump table a higher priority }
         max_dist:=(max_dist*3) div 2;
@@ -63,7 +63,7 @@ unit ncpuset;
       end;
 
 
-    procedure tcpucasenode.genjumptable(hp : pcaselabel;min_,max_ : aint);
+    procedure tcpucasenode.genjumptable(hp : pcaselabel;min_,max_ : int64);
       var
         base,
         table : tasmlabel;
@@ -74,22 +74,22 @@ unit ncpuset;
 
         procedure genitem(list:TAsmList;t : pcaselabel);
           var
-            i : aint;
+            i : TConstExprInt;
           begin
             if assigned(t^.less) then
               genitem(list,t^.less);
             { fill possible hole }
-            i:=last.svalue+1;
-            while i<=t^._low.svalue-1 do
+            i:=last+1;
+            while i<=t^._low-1 do
               begin
                 list.concat(Tai_const.Create_rel_sym(aitconst_ptr,base,elselabel));
-                inc(i);
+                i:=i+1;
               end;
-            i:=t^._low.svalue;
-            while i<=t^._high.svalue do
+            i:=t^._low;
+            while i<=t^._high do
               begin
                 list.concat(Tai_const.Create_rel_sym(aitconst_ptr,base,blocklabel(t^.blockid)));
-                inc(i);
+                i:=i+1;
               end;
             last:=t^._high;
             if assigned(t^.greater) then

compiler/symdef.pas

@@ -1820,6 +1820,8 @@ implementation
 {$endif}
          generictokenbuf:=nil;
          genericdef:=nil;
+         typesymderef.reset;
+         genericdefderef.reset;
 
          { Don't register forwarddefs, they are disposed at the
            end of an type block }
@@ -2616,6 +2618,7 @@ implementation
          calcsavesize(current_settings.packenum);
          has_jumps:=false;
          basedef:=nil;
+         basedefderef.reset;
          symtable:=tenumsymtable.create(self);
       end;
 
@@ -3127,6 +3130,7 @@ implementation
          inherited create(filedef,true);
          filetyp:=ft_text;
          typedfiledef:=nil;
+         typedfiledefderef.reset;
       end;
 
 
@@ -3355,6 +3359,7 @@ implementation
       begin
         inherited create(dt,true);
         pointeddef:=def;
+        pointeddefderef.reset;
         if df_generic in pointeddef.defoptions then
           include(defoptions,df_generic);
         if df_specialization in pointeddef.defoptions then
@@ -3605,6 +3610,7 @@ implementation
       begin
          inherited create(setdef,doregister);
          elementdef:=def;
+         elementdefderef.reset;
          setmax:=high;
          actual_setalloc:=current_settings.setalloc;
 {$if defined(cpu8bitalu) or defined(cpu16bitalu)}
@@ -3749,7 +3755,9 @@ implementation
          lowrange:=l;
          highrange:=h;
          rangedef:=def;
+         rangedefderef.reset;
          _elementdef:=nil;
+         _elementdefderef.reset;
          arrayoptions:=[];
          symtable:=tarraysymtable.create(self);
       end;
@@ -4486,6 +4494,7 @@ implementation
          if symtable.refcount=1 then
            symtable.defowner:=self;
          isunion:=false;
+         cloneddefderef.reset;
       end;
 
 
@@ -4818,6 +4827,7 @@ implementation
          proccalloption:=pocall_none;
          procoptions:=[];
          returndef:=voidtype;
+         returndefderef.reset;
          savesize:=sizeof(pint);
          callerargareasize:=0;
          calleeargareasize:=0;
@@ -5623,10 +5633,13 @@ implementation
          extnumber:=$ffff;
          aliasnames:=TCmdStrList.create;
          funcretsym:=nil;
+         funcretsymderef.reset;
+         procsymderef.reset;
          forwarddef:=true;
          interfacedef:=false;
          hasforward:=false;
          struct := nil;
+         structderef.reset;
          import_dll:=nil;
          import_name:=nil;
          import_nr:=0;
@@ -6744,6 +6757,10 @@ implementation
         fcurrent_dispid:=0;
         objecttype:=ot;
         childof:=nil;
+        childofderef.reset;
+        vmt_fieldderef.reset;
+        extendeddefderef.reset;
+        cloneddefderef.reset;
         if objecttype=odt_helper then
           owner.includeoption(sto_has_helper);
         symtable:=tObjectSymtable.create(self,n,current_settings.packrecords,
@@ -7794,6 +7811,7 @@ implementation
       begin
         inherited create;
         intfdef:=aintf;
+        intfdefderef.reset;
         IOffset:=-1;
         IType:=etStandard;
         NameMappings:=nil;

compiler/symsym.pas

@@ -753,6 +753,7 @@ implementation
       begin
          inherited create(namespacesym,n,true);
          unitsym:=nil;
+         unitsymderef.reset;
       end;
 
     constructor tnamespacesym.ppuload(ppufile:tcompilerppufile);
@@ -1333,7 +1334,9 @@ implementation
          index:=0;
          default:=0;
          propdef:=nil;
+         propdefderef.reset;
          indexdef:=nil;
+         indexdefderef.reset;
          parast:=nil;
          for pap:=low(tpropaccesslisttypes) to high(tpropaccesslisttypes) do
            propaccesslist[pap]:=tpropaccesslist.create;
@@ -1590,6 +1593,7 @@ implementation
       begin
          inherited create(st,n,doregister);
          vardef:=def;
+         vardefderef.reset;
          varspez:=vsp;
          varstate:=vs_declared;
          varoptions:=vopts;
@@ -1839,6 +1843,7 @@ implementation
          fillchar(localloc,sizeof(localloc),0);
          fillchar(initialloc,sizeof(initialloc),0);
          defaultconstsym:=nil;
+         defaultconstsymderef.reset;
       end;
 
 
@@ -1897,6 +1902,7 @@ implementation
     constructor tstaticvarsym.create(const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions;doregister:boolean);
       begin
          inherited create(staticvarsym,n,vsp,def,vopts,doregister);
+         fieldvarsymderef.reset;
 {$ifdef symansistr}
          _mangledname:='';
 {$else symansistr}
@@ -2298,6 +2304,7 @@ implementation
          consttyp:=t;
          value.valueord:=v;
          constdef:=def;
+         constdefderef.reset;
       end;
 
 
@@ -2308,6 +2315,7 @@ implementation
          consttyp:=t;
          value.valueordptr:=v;
          constdef:=def;
+         constdefderef.reset;
       end;
 
 
@@ -2318,6 +2326,7 @@ implementation
          consttyp:=t;
          value.valueptr:=v;
          constdef:=def;
+         constdefderef.reset;
       end;
 
 
@@ -2331,6 +2340,7 @@ implementation
            constdef:=def
          else
            constdef:=carraydef.getreusable(cansichartype,l);
+         constdefderef.reset;
          value.len:=l;
       end;
 
@@ -2342,6 +2352,7 @@ implementation
          consttyp:=t;
          pcompilerwidestring(value.valueptr):=pw;
          constdef:=carraydef.getreusable(cwidechartype,getlengthwidestring(pw));
+         constdefderef.reset;
          value.len:=getlengthwidestring(pw);
       end;
 
@@ -2532,6 +2543,7 @@ implementation
       begin
          inherited create(enumsym,n,true);
          definition:=def;
+         definitionderef.reset;
          value:=v;
       end;
 
@@ -2576,6 +2588,7 @@ implementation
       begin
         inherited create(typesym,n,doregister);
         typedef:=def;
+        typedefderef.reset;
         { register the typesym for the definition }
         if assigned(typedef) and
            (typedef.typ<>errordef) and

compiler/symtable.pas

@@ -732,6 +732,7 @@ implementation
         newbuiltdefderefs,
         builtdefderefs,
         builtsymderefs: array of boolean;
+        changed: boolean;
       begin
         newbuiltdefderefs:=nil;
         builtdefderefs:=nil;
@@ -749,6 +750,7 @@ implementation
           { current number of registered defs/syms }
           defidmax:=current_module.deflist.count;
           symidmax:=current_module.symlist.count;
+          changed:=false;
 
           { build the derefs for the registered defs we haven't processed yet }
           for i:=0 to DefList.Count-1 do
@@ -761,6 +763,7 @@ implementation
                       def.buildderef;
                       newbuiltdefderefs[i]:=true;
                       builtdefderefs[i]:=true;
+                      changed:=true;
                     end;
                 end;
             end;
@@ -774,6 +777,7 @@ implementation
                     begin
                       sym.buildderef;
                       builtsymderefs[i]:=true;
+                      changed:=true;
                     end;
                 end;
             end;
@@ -784,12 +788,13 @@ implementation
                 begin
                   newbuiltdefderefs[i]:=false;
                   tstoreddef(DefList[i]).buildderefimpl;
+                  changed:=true;
                 end;
             end;
         { stop when no new defs or syms have been registered while processing
           the currently registered ones (defs/syms get added to the module's
           deflist/symlist when they are registered) }
-        until
+        until not changed and 
           (defidmax=current_module.deflist.count) and
           (symidmax=current_module.symlist.count);
       end;

compiler/symtype.pas

@@ -1103,7 +1103,10 @@ implementation
       begin
         oldcrc:=do_crc;
         do_crc:=false;
-        putlongint(d.dataidx);
+        if d.dataidx=-1 then
+          internalerror(2019022201)
+        else
+          putlongint(d.dataidx);
         do_crc:=oldcrc;
       end;
 

compiler/x86/nx86set.pas

@@ -37,7 +37,7 @@ interface
 
       tx86casenode = class(tcgcasenode)
          function  has_jumptable : boolean;override;
-         procedure genjumptable(hp : pcaselabel;min_,max_ : aint);override;
+         procedure genjumptable(hp : pcaselabel;min_,max_ : int64);override;
          procedure genlinearlist(hp : pcaselabel);override;
          procedure genjmptreeentry(p : pcaselabel;parentvalue : TConstExprInt);override;
       end;
@@ -66,7 +66,7 @@ implementation
       end;
 
 
-    procedure tx86casenode.genjumptable(hp : pcaselabel;min_,max_ : aint);
+    procedure tx86casenode.genjumptable(hp : pcaselabel;min_,max_ : int64);
       var
         table : tasmlabel;
         last : TConstExprInt;
@@ -78,30 +78,30 @@ implementation
         labeltyp: taiconst_type;
         AlmostExhaustive: Boolean;
         lv, hv: TConstExprInt;
-        ExhaustiveLimit, Range, x, oldmin : aint;
+        ExhaustiveLimit, Range, x, oldmin : int64;
 
       const
         ExhaustiveLimitBase = 32;
 
         procedure genitem(list:TAsmList;t : pcaselabel);
           var
-            i : aint;
+            i : TConstExprInt;
           begin
             if assigned(t^.less) then
               genitem(list,t^.less);
 
             { fill possible hole }
-            i:=last.svalue+1;
-            while i<=t^._low.svalue-1 do
+            i:=last+1;
+            while i<=t^._low-1 do
               begin
                 list.concat(Tai_const.Create_type_sym(labeltyp,elselabel));
-                inc(i);
+                i:=i+1;
               end;
-            i:=t^._low.svalue;
-            while i<=t^._high.svalue do
+            i:=t^._low;
+            while i<=t^._high do
               begin
                 list.concat(Tai_const.Create_type_sym(labeltyp,blocklabel(t^.blockid)));
-                inc(i);
+                i:=i+1;
               end;
             last:=t^._high;
             if assigned(t^.greater) then

compiler/x86_64/nx64set.pas

@@ -32,8 +32,8 @@ interface
 
     type
       tx8664casenode = class(tx86casenode)
-         procedure optimizevalues(var max_linear_list:aint;var max_dist:aword);override;
-         procedure genjumptable(hp : pcaselabel;min_,max_ : aint);override;
+         procedure optimizevalues(var max_linear_list:int64;var max_dist:qword);override;
+         procedure genjumptable(hp : pcaselabel;min_,max_ : int64);override;
       end;
 
 
@@ -53,7 +53,7 @@ implementation
                             TX8664CASENODE
 *****************************************************************************}
 
-    procedure tx8664casenode.optimizevalues(var max_linear_list:aint;var max_dist:aword);
+    procedure tx8664casenode.optimizevalues(var max_linear_list:int64;var max_dist:qword);
       begin
         inc(max_linear_list,9);
       end;
@@ -61,7 +61,7 @@ implementation
 
     { Always generate position-independent jump table, it is twice less in size at a price
       of two extra instructions (which shouldn't cause more slowdown than pipeline trashing) }
-    procedure tx8664casenode.genjumptable(hp : pcaselabel; min_,max_ : aint);
+    procedure tx8664casenode.genjumptable(hp : pcaselabel; min_,max_ : int64);
       var
         last: TConstExprInt;
         tablelabel: TAsmLabel;
@@ -80,22 +80,22 @@ implementation
 
       procedure genitem(t : pcaselabel);
         var
-          i : aint;
+          i : TConstExprInt;
         begin
           if assigned(t^.less) then
             genitem(t^.less);
           { fill possible hole }
-          i:=last.svalue+1;
-          while i<=t^._low.svalue-1 do
+          i:=last+1;
+          while i<=t^._low-1 do
             begin
               jtlist.concat(Tai_const.Create_rel_sym(jtitemconsttype,tablelabel,elselabel));
-              inc(i);
+              i:=i+1;
             end;
-          i:=t^._low.svalue;
-          while i<=t^._high.svalue do
+          i:=t^._low;
+          while i<=t^._high do
             begin
               jtlist.concat(Tai_const.Create_rel_sym(jtitemconsttype,tablelabel,blocklabel(t^.blockid)));
-              inc(i);
+              i:=i+1;
             end;
           last:=t^._high;
           if assigned(t^.greater) then

packages/fcl-db/fpmake.pp

@@ -831,6 +831,9 @@ begin
     with T.Dependencies do
       AddUnit('fpjsondataset');
 
+    T:=P.Targets.AddUnit('sqldbini.pp');
+    with T.Dependencies do
+      AddUnit('sqldb');
 
     P.ExamplePath.Add('tests');
     T:=P.Targets.AddExampleProgram('dbftoolsunit.pas', DBaseOSes);

packages/fcl-db/src/sqldb/sqldbini.pp

@@ -0,0 +1,219 @@
+unit sqldbini;
+
+{$mode objfpc}{$H+}
+{$modeswitch typehelpers}
+
+interface
+
+uses
+  Classes, SysUtils, sqldb, inifiles, strutils;
+
+Type
+  TSQLDBIniOption = (sioClearOnRead,      // Clear values first
+                     sioSkipPassword,     // Do not save/load password
+                     sioSkipMaskPassword, // do not mask the password
+                     sioUserNameAsMask,   // use the username as mask for password
+                     sioSkipParams        // Do not read/write params.
+                     );
+  TSQLDBIniOptions = set of TSQLDBIniOption;
+
+  { TSQLDBIniHelper }
+
+  TSQLDBIniHelper = class helper for TSQLConnection
+  Private
+    Procedure ClearValues;
+  Public
+    Procedure LoadFromIni(Const aIni: TCustomIniFile; aOptions : TSQLDBIniOptions = []); overload;
+    Procedure LoadFromIni(Const aIni: TCustomIniFile; ASection : String; aOptions : TSQLDBIniOptions); overload;
+    Procedure LoadFromFile(Const aFileName : String; aOptions : TSQLDBIniOptions = []); overload;
+    Procedure LoadFromFile(Const aFileName : String; Const ASection : String; aOptions : TSQLDBIniOptions); overload;
+    Procedure SaveToFile(Const aFileName : String; aOptions : TSQLDBIniOptions = []);overload;
+    Procedure SaveToFile(Const aFileName : String; Const ASection : String; aOptions : TSQLDBIniOptions = []);overload;
+    Procedure SaveToIni(Const aIni: TCustomIniFile; aOptions : TSQLDBIniOptions = []); overload;
+    Procedure SaveToIni(Const aIni: TCustomIniFile; ASection : String; aOptions : TSQLDBIniOptions); overload;
+  end;
+
+Var
+  TrivialEncryptKey : String = 'SQLDB';
+  DefaultSection : String = 'Connection';
+
+implementation
+
+{ TSQLDBIniHelper }
+
+procedure TSQLDBIniHelper.ClearValues;
+begin
+  HostName:='';
+  DatabaseName:='';
+  UserName:='';
+  Password:='';
+  CharSet:='';
+  Params.Clear;
+  Port:=0;
+end;
+
+
+Const
+  KeyHost = 'Host';
+  KeyDatabaseName = 'DatabaseName';
+  KeyUserName = 'UserName';
+  KeyPassword = 'Password';
+  KeyPort = 'Port';
+  keyParams = 'Params';
+  KeyCharset = 'Charset';
+  KeyRole = 'Role';
+
+Const
+  ForbiddenParamKeys : Array[1..8] of unicodestring
+                     = (keyHost,KeyDatabaseName,KeyUserName,KeyPassword,KeyPort,keyParams,keyCharSet,keyRole);
+  ParamSeps = [',',';',' '];
+
+procedure TSQLDBIniHelper.LoadFromIni(const aIni: TCustomIniFile; ASection: String; aOptions: TSQLDBIniOptions);
+
+Var
+  M,N,P : String;
+  I : integer;
+
+begin
+  With aIni do
+    begin
+    if (sioClearOnRead in aOptions) then
+       ClearValues;
+    HostName:=ReadString(ASection,KeyHost,HostName);
+    DatabaseName:=ReadString(ASection,KeyDatabaseName,DatabaseName);
+    UserName:=ReadString(ASection,KeyUserName,UserName);
+    CharSet:=ReadString(ASection,KeyCharset,CharSet);
+    Role:=ReadString(ASection,KeyRole,Role);
+    Port:=ReadInteger(ASection,KeyPort,Port);
+    // optional parts
+    if not (sioSkipPassword in aOptions) then
+      begin
+      if sioSkipMaskPassword in aOptions then
+        P:=ReadString(ASection,KeyPassword,Password)
+      else
+        begin
+        P:=ReadString(ASection,KeyPassword,'');
+        if (P<>'') then
+          begin
+          if sioUserNameAsMask in aOptions then
+            M:=UserName
+          else
+            M:=TrivialEncryptKey;
+          P:=XorDecode(M,P);
+          end;
+        end;
+      Password:=P;
+      end;
+    if not (sioSkipParams in aOptions) then
+      begin
+      M:=ReadString(ASection,keyParams,'');
+      For I:=1 to WordCount(M,ParamSeps) do
+        begin
+        N:=ExtractWord(I,M,ParamSeps);
+        if IndexStr(Utf8Decode(N),ForbiddenParamKeys)=-1 then
+          begin
+          P:=ReadString(ASection,N,'');
+          Params.Values[N]:=P;
+          end;
+        end;
+      end;
+    end;
+end;
+
+procedure TSQLDBIniHelper.LoadFromIni(const aIni: TCustomIniFile; aOptions: TSQLDBIniOptions);
+begin
+  LoadFromIni(aIni,Defaultsection,aOptions);
+end;
+
+procedure TSQLDBIniHelper.LoadFromFile(const aFileName: String; aOptions: TSQLDBIniOptions);
+
+
+begin
+  Loadfromfile(aFileName,DefaultSection,aOptions);
+end;
+
+procedure TSQLDBIniHelper.LoadFromFile(const aFileName: String; const ASection: String; aOptions: TSQLDBIniOptions);
+
+Var
+  Ini : TCustomIniFile;
+
+begin
+  Ini:=TMeminiFile.Create(aFileName);
+  try
+    LoadFromIni(Ini,aSection,aOptions);
+  finally
+    Ini.Free;
+  end;
+end;
+
+procedure TSQLDBIniHelper.SaveToFile(const aFileName: String; aOptions: TSQLDBIniOptions);
+begin
+  SaveToFile(aFileName,DefaultSection,aOptions);
+end;
+
+procedure TSQLDBIniHelper.SaveToFile(const aFileName: String; const ASection: String; aOptions: TSQLDBIniOptions);
+Var
+  Ini : TCustomIniFile;
+
+begin
+  Ini:=TMeminiFile.Create(aFileName);
+  try
+    SaveToini(Ini,aSection,aOptions);
+  finally
+    Ini.Free;
+  end;
+end;
+
+procedure TSQLDBIniHelper.SaveToIni(const aIni: TCustomIniFile; aOptions: TSQLDBIniOptions);
+begin
+  SaveToIni(aIni,DefaultSection,aOptions);
+end;
+
+procedure TSQLDBIniHelper.SaveToIni(const aIni: TCustomIniFile; ASection: String; aOptions: TSQLDBIniOptions);
+Var
+  M,N,P : String;
+  I : integer;
+
+begin
+  With aIni do
+    begin
+    WriteString(ASection,KeyHost,HostName);
+    WriteString(ASection,KeyDatabaseName,DatabaseName);
+    WriteString(ASection,KeyUserName,UserName);
+    WriteString(ASection,KeyCharset,CharSet);
+    WriteString(ASection,KeyRole,Role);
+    WriteInteger(ASection,KeyPort,Port);
+    if not (sioSkipPassword in aOptions) then
+      begin
+      P:=Password;
+      if Not (sioSkipMaskPassword in aOptions) then
+        begin
+        if sioUserNameAsMask in aOptions then
+          M:=UserName
+        else
+          M:=TrivialEncryptKey;
+        P:=XorEncode(M,P);
+        end;
+      WriteString(ASection,KeyPassword,P);
+      end;
+    if not (sioSkipParams in aOptions) then
+      begin
+      M:='';
+      for I:=0 to Params.Count-1 do
+        begin
+        Params.GetNameValue(I,N,P);
+        if (N<>'') and (IndexStr(Utf8Decode(N),ForbiddenParamKeys)=-1) then
+          begin
+          WriteString(ASection,N,P);
+          if (M<>'') then
+            M:=M+',';
+          M:=M+N;
+          end;
+        end;
+      WriteString(ASection,KeyParams,M);
+      end;
+    end;
+end;
+
+end.
+

packages/fcl-passrc/src/pasresolveeval.pas

@@ -184,6 +184,9 @@ const
   nBitWiseOperationsAre32Bit = 3118;
   nImplictConversionUnicodeToAnsi = 3119;
   nWrongTypeXInArrayConstructor = 3120;
+  nUnknownCustomAttributeX = 3121;
+  nAttributeIgnoredBecauseAbstractX = 3122;
+  nCreatingAnInstanceOfAbstractClassY = 3123;
 
   // using same IDs as FPC
   nVirtualMethodXHasLowerVisibility = 3250; // was 3050
@@ -315,6 +318,9 @@ resourcestring
   sBitWiseOperationsAre32Bit = 'Bitwise operations are 32-bit';
   sImplictConversionUnicodeToAnsi = 'Implicit string type conversion with potential data loss from "UnicodeString" to "AnsiString"';
   sWrongTypeXInArrayConstructor = 'Wrong type "%s" in array constructor';
+  sUnknownCustomAttributeX = 'Unknown custom attribute "%s"';
+  sAttributeIgnoredBecauseAbstractX = 'attribute ignored because abstract %s';
+  sCreatingAnInstanceOfAbstractClassY = 'Creating an instance of abstract class "%s"';
 
 type
   { TResolveData - base class for data stored in TPasElement.CustomData }
@@ -361,7 +367,7 @@ const
   MinSafeIntSingle = -16777216;
   MaxSafeIntSingle =  16777216;
   MaskUIntSingle = $3fffff;
-  MinSafeIntDouble = -$1fffffffffffff; // -9007199254740991 53 bits (52 explicitly stored)
+  MinSafeIntDouble = -$1fffffffffffff; // -9007199254740991 54 bits (52 plus signed bit plus implicit highest bit)
   MaxSafeIntDouble =  $1fffffffffffff; //  9007199254740991
   MaskUIntDouble = $1fffffffffffff;
 

packages/fcl-passrc/src/pasresolver.pp

@@ -1065,9 +1065,24 @@ type
     class function IsStoredInElement: boolean; override;
   end;
 
+  { TPasDotBaseScope }
+
+  TPasDotBaseScope = Class(TPasSubExprScope)
+  public
+    GroupScope: TPasGroupScope;
+    OnlyTypeMembers: boolean; // true=only class var/procs, false=default=all
+    ConstParent: boolean;
+    function FindIdentifier(const Identifier: String): TPasIdentifier; override;
+    procedure IterateElements(const aName: string; StartScope: TPasScope;
+      const OnIterateElement: TIterateScopeElement; Data: Pointer;
+      var Abort: boolean); override;
+    procedure WriteIdentifiers(Prefix: string); override;
+    destructor Destroy; override;
+  end;
+
   { TPasModuleDotScope - scope for searching unitname.<identifier> }
 
-  TPasModuleDotScope = Class(TPasSubExprScope)
+  TPasModuleDotScope = Class(TPasDotBaseScope)
   private
     FModule: TPasModule;
     procedure OnInternalIterate(El: TPasElement; ElScope, StartScope: TPasScope;
@@ -1086,21 +1101,6 @@ type
     property Module: TPasModule read FModule write SetModule;
   end;
 
-  { TPasDotBaseScope }
-
-  TPasDotBaseScope = Class(TPasSubExprScope)
-  public
-    GroupScope: TPasGroupScope;
-    OnlyTypeMembers: boolean; // true=only class var/procs, false=default=all
-    ConstParent: boolean;
-    function FindIdentifier(const Identifier: String): TPasIdentifier; override;
-    procedure IterateElements(const aName: string; StartScope: TPasScope;
-      const OnIterateElement: TIterateScopeElement; Data: Pointer;
-      var Abort: boolean); override;
-    procedure WriteIdentifiers(Prefix: string); override;
-    destructor Destroy; override;
-  end;
-
   { TPasDotEnumTypeScope - used for EnumType.EnumValue }
 
   TPasDotEnumTypeScope = Class(TPasDotBaseScope)
@@ -1204,11 +1204,18 @@ type
     property Declaration: TPasElement read FDeclaration write SetDeclaration;
   end;
 
-  { TResolvedRefCtxConstructor - constructed class/record of a newinstance reference }
+  { TResolvedRefCtxConstructor - constructed type of a newinstance reference }
 
   TResolvedRefCtxConstructor = Class(TResolvedRefContext)
   public
-    Typ: TPasType; // e.g. TPasMembersType
+    Typ: TPasType;
+  end;
+
+  { TResolvedRefCtxAttrProc - constructor of an attribute }
+
+  TResolvedRefCtxAttrProc = Class(TResolvedRefContext)
+  public
+    Proc: TPasConstructor;
   end;
 
   TPasResolverResultFlag = (
@@ -1481,8 +1488,10 @@ type
     procedure ResolveBinaryExpr(El: TBinaryExpr; Access: TResolvedRefAccess); virtual;
     procedure ResolveSubIdent(El: TBinaryExpr; Access: TResolvedRefAccess); virtual;
     procedure ResolveParamsExpr(Params: TParamsExpr; Access: TResolvedRefAccess); virtual;
+    procedure ResolveParamsExprParams(Params: TParamsExpr); virtual;
     procedure ResolveFuncParamsExpr(Params: TParamsExpr; Access: TResolvedRefAccess); virtual;
-    procedure ResolveFuncParamsExprName(NameExpr: TPasExpr; Params: TParamsExpr; Access: TResolvedRefAccess); virtual;
+    procedure ResolveFuncParamsExprName(NameExpr: TPasExpr; Params: TParamsExpr;
+      Access: TResolvedRefAccess; CallName: string = ''); virtual;
     procedure ResolveArrayParamsExpr(Params: TParamsExpr; Access: TResolvedRefAccess); virtual;
     procedure ResolveArrayParamsExprName(NameExpr: TPasExpr; Params: TParamsExpr; Access: TResolvedRefAccess); virtual;
     procedure ResolveArrayParamsArgs(Params: TParamsExpr;
@@ -1531,6 +1540,7 @@ type
     procedure FinishArgument(El: TPasArgument); virtual;
     procedure FinishAncestors(aClass: TPasClassType); virtual;
     procedure FinishMethodResolution(El: TPasMethodResolution); virtual;
+    procedure FinishAttributes(El: TPasAttributes); virtual;
     procedure FinishProcParamAccess(ProcType: TPasProcedureType; Params: TParamsExpr); virtual;
     procedure FinishPropertyParamAccess(Params: TParamsExpr;
       Prop: TPasProperty); virtual;
@@ -2027,6 +2037,10 @@ type
     function IsInterfaceType(TypeEl: TPasType; IntfType: TPasClassInterfaceType): boolean; overload;
     function IsTGUID(RecTypeEl: TPasRecordType): boolean; virtual;
     function IsTGUIDString(const ResolvedEl: TPasResolverResult): boolean; virtual;
+    function IsCustomAttribute(El: TPasElement): boolean; virtual;
+    function IsSystemUnit(El: TPasModule): boolean; virtual;
+    function GetAttributeCallsEl(El: TPasElement): TPasExprArray; virtual;
+    function GetAttributeCalls(Members: TFPList; Index: integer): TPasExprArray; virtual;
     function ProcNeedsParams(El: TPasProcedureType): boolean;
     function IsProcOverride(AncestorProc, DescendantProc: TPasProcedure): boolean;
     function GetTopLvlProc(El: TPasElement): TPasProcedure;
@@ -6383,6 +6397,8 @@ begin
     FinishArgument(TPasArgument(El))
   else if C=TPasMethodResolution then
     FinishMethodResolution(TPasMethodResolution(El))
+  else if C=TPasAttributes then
+    FinishAttributes(TPasAttributes(El))
   else
     begin
     {$IFDEF VerbosePasResolver}
@@ -7119,14 +7135,16 @@ var
   IntfType, IntfTypeRes, HelperForType, AncestorHelperFor: TPasType;
   ResIntfList, Members: TFPList;
   GroupScope: TPasGroupScope;
+  C: TClass;
 begin
   if aClass.IsForward then
     begin
     // check for duplicate forwards
-    if aClass.Parent is TPasDeclarations then
+    C:=aClass.Parent.ClassType;
+    if C.InheritsFrom(TPasDeclarations) then
       Members:=TPasDeclarations(aClass.Parent).Declarations
-    else if aClass.Parent.ClassType=TPasClassType then
-      Members:=TPasClassType(aClass.Parent).Members
+    else if (C=TPasClassType) or (C=TPasRecordType) then
+      Members:=TPasMembersType(aClass.Parent).Members
     else
       RaiseNotYetImplemented(20180430141934,aClass,GetObjName(aClass.Parent));
     for i:=0 to Members.Count-1 do
@@ -7238,6 +7256,7 @@ begin
     aModifier:=lowercase(aClass.Modifiers[i]);
     case aModifier of
     'sealed': IsSealed:=true;
+    'abstract': ;
     else
       RaiseMsg(20170320190619,nIllegalQualifier,sIllegalQualifier,[aClass.Modifiers[i]],aClass);
     end;
@@ -7486,6 +7505,166 @@ begin
   // El.ImplementationProc is resolved in FinishClassType
 end;
 
+procedure TPasResolver.FinishAttributes(El: TPasAttributes);
+var
+  i, j: Integer;
+  NameExpr, Expr: TPasExpr;
+  Bin: TBinaryExpr;
+  LeftResolved, ParamResolved: TPasResolverResult;
+  aModule: TPasModule;
+  LTypeEl: TPasType;
+  AttrName: String;
+  Data: TPRFindData;
+  CurEl, DeclEl: TPasElement;
+  ClassEl: TPasClassType;
+  aConstructor: TPasConstructor;
+  Args: TFPList;
+  AttrRef, ParamRef: TResolvedReference;
+  DotScope: TPasDotBaseScope;
+  Params: TPasExprArray;
+begin
+  for i:=0 to length(El.Calls)-1 do
+    begin
+    NameExpr:=El.Calls[i];
+    {$IFDEF VerbosePasResolver}
+    //writeln('TPasResolver.FinishAttributes El.Calls[',i,']=',GetObjName(NameExpr));
+    {$ENDIF}
+    if NameExpr is TParamsExpr then
+      NameExpr:=TParamsExpr(NameExpr).Value;
+    DotScope:=nil;
+    if NameExpr is TBinaryExpr then
+      begin
+      Bin:=TBinaryExpr(NameExpr);
+      ResolveExpr(Bin.left,rraRead);
+      ComputeElement(Bin.Left,LeftResolved,[rcType,rcSetReferenceFlags]);
+      if LeftResolved.BaseType=btModule then
+        begin
+        // e.g. unitname.identifier
+        // => search in interface and if this is our module in the implementation
+        aModule:=NoNil(LeftResolved.IdentEl) as TPasModule;
+        DotScope:=PushModuleDotScope(aModule);
+        end
+      else if (LeftResolved.BaseType=btContext)
+          and (LeftResolved.IdentEl is TPasType)
+          and (LeftResolved.LoTypeEl is TPasMembersType) then
+        begin
+        // classtype.identifier or recordtype.identifier
+        LTypeEl:=LeftResolved.LoTypeEl;
+        if LTypeEl.ClassType=TPasClassType then
+          begin
+          DotScope:=PushClassDotScope(TPasClassType(LTypeEl));
+          DotScope.OnlyTypeMembers:=true;
+          end
+        else if LTypeEl.ClassType=TPasRecordType then
+          begin
+          DotScope:=PushRecordDotScope(TPasRecordType(LTypeEl));
+          DotScope.OnlyTypeMembers:=true;
+          end
+        else
+          RaiseNotYetImplemented(20190221124930,Bin);
+        end
+      else
+        RaiseMsg(20190221102049,nXExpectedButYFound,sXExpectedButYFound,
+          ['module or type',GetResolverResultDescription(LeftResolved,true)],NameExpr);
+      NameExpr:=Bin.right;
+      end;
+    // find attribute class
+    if not IsNameExpr(NameExpr) then
+      RaiseMsg(20190221125204,nXExpectedButYFound,sXExpectedButYFound,
+        ['identifier',GetElementTypeName(Bin)],NameExpr);
+    AttrName:=TPrimitiveExpr(NameExpr).Value;
+    CurEl:=nil;
+    if not SameText(RightStr(AttrName,length('Attribute')),'Attribute') then
+      begin
+      // first search AttrName+'Attibute'
+      CurEl:=FindFirstEl(AttrName+'Attribute',Data,NameExpr);
+      end;
+    // then search the name
+    if CurEl=nil then
+      CurEl:=FindFirstEl(AttrName,Data,NameExpr);
+    if DotScope<>nil then
+      PopScope;
+    {$IFDEF VerbosePasResolver}
+    writeln('TPasResolver.FinishAttributes Found Attr "'+AttrName+'"=',GetObjName(CurEl),' TopScope=',GetObjName(TopScope));
+    {$ENDIF}
+
+    // check if found element is a TCustomAttribute
+    if CurEl=nil then
+      begin
+      LogMsg(20190221144613,mtWarning,nUnknownCustomAttributeX,sUnknownCustomAttributeX,
+        [AttrName],NameExpr);
+      continue;
+      end;
+    if not IsCustomAttribute(CurEl) then
+      RaiseMsg(20190221130400,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
+        [GetElementTypeName(CurEl),'TCustomAttribute'],NameExpr);
+    ClassEl:=TPasClassType(CurEl);
+    AttrRef:=CreateReference(ClassEl,NameExpr,rraRead);
+    if ClassEl.IsAbstract then
+      // Delphi silently skips attributes using abstract classes/methods
+      LogMsg(20190223194424,mtWarning,nAttributeIgnoredBecauseAbstractX,
+        sAttributeIgnoredBecauseAbstractX,['class'],NameExpr);
+
+    // search constructor "Create" using the params
+    DotScope:=PushClassDotScope(ClassEl);
+    DotScope.OnlyTypeMembers:=true;
+    Expr:=El.Calls[i];
+    if Expr is TParamsExpr then
+      begin
+      // attribute with params
+      if Expr.Kind<>pekFuncParams then
+        begin
+        {$IFDEF VerbosePasResolver}
+        writeln('TPasResolver.FinishAttributes ',ExprKindNames[Expr.Kind]);
+        {$ENDIF}
+        RaiseMsg(20190223195605,nXExpectedButYFound,sXExpectedButYFound,
+          ['(','['],Expr);
+        end;
+      // first resolve params
+      ResolveParamsExprParams(TParamsExpr(Expr));
+      // then resolve call 'Create'
+      ResolveFuncParamsExprName(Expr,TParamsExpr(Expr),rraRead,'Create');
+      // then check that each parameter is a constant expression
+      Params:=TParamsExpr(Expr).Params;
+      for j:=0 to length(Params)-1 do
+        ComputeElement(Params[j],ParamResolved,[rcConstant]);
+      // check if call is constructor
+      ParamRef:=Expr.CustomData as TResolvedReference;
+      DeclEl:=ParamRef.Declaration;
+      if DeclEl.ClassType<>TPasConstructor then
+        RaiseXExpectedButYFound(20190221150212,'constructor Create',GetElementTypeName(DeclEl),NameExpr);
+      aConstructor:=TPasConstructor(DeclEl);
+      end
+    else
+      begin
+      // attribute without params
+      // -> resolve call 'Create'
+      DeclEl:=FindElementWithoutParams('Create',Data,NameExpr,false);
+      if DeclEl=nil then
+        RaiseIdentifierNotFound(20190221144516,'Create',NameExpr);
+      // check call is constructor
+      if DeclEl.ClassType<>TPasConstructor then
+        RaiseXExpectedButYFound(20190221145003,'constructor Create',
+          GetElementTypeName(DeclEl),NameExpr);
+      aConstructor:=TPasConstructor(DeclEl);
+      // check constructor without needed args
+      Args:=aConstructor.ProcType.Args;
+      if (Args.Count>0) and (TPasArgument(Args[0]).ValueExpr=nil) then
+        RaiseMsg(20190221145407,nWrongNumberOfParametersForCallTo,
+          sWrongNumberOfParametersForCallTo,[aConstructor.Name],Expr);
+      end;
+    if aConstructor.IsAbstract then
+      LogMsg(20190223193645,mtWarning,nAttributeIgnoredBecauseAbstractX,
+        sAttributeIgnoredBecauseAbstractX,['mrthod'],NameExpr);
+    // store reference to constructor in NameExpr
+    if AttrRef.Context<>nil then
+      RaiseNotYetImplemented(20190221164717,NameExpr,GetObjName(AttrRef.Context));
+    AttrRef.Context:=TResolvedRefCtxAttrProc.Create;
+    TResolvedRefCtxAttrProc(AttrRef.Context).Proc:=aConstructor;
+    PopScope;
+    end;
+end;
+
 procedure TPasResolver.FinishProcParamAccess(ProcType: TPasProcedureType;
   Params: TParamsExpr);
 var
@@ -9057,9 +9236,6 @@ end;
 
 procedure TPasResolver.ResolveParamsExpr(Params: TParamsExpr;
   Access: TResolvedRefAccess);
-var
-  i, ScopeDepth: Integer;
-  ParamAccess: TResolvedRefAccess;
 begin
   if (Params.Kind=pekSet) and not (Access in [rraRead,rraParamToUnknownProc]) then
     begin
@@ -9070,14 +9246,7 @@ begin
     end;
 
   // first resolve params
-  ResetSubExprScopes(ScopeDepth);
-  if Params.Kind in [pekFuncParams,pekArrayParams] then
-    ParamAccess:=rraParamToUnknownProc
-  else
-    ParamAccess:=rraRead;
-  for i:=0 to length(Params.Params)-1 do
-    ResolveExpr(Params.Params[i],ParamAccess);
-  RestoreSubExprScopes(ScopeDepth);
+  ResolveParamsExprParams(Params);
 
   // then resolve the call, typecast, array, set
   if (Params.Kind=pekFuncParams) then
@@ -9090,6 +9259,23 @@ begin
     RaiseNotYetImplemented(20160922163501,Params);
 end;
 
+procedure TPasResolver.ResolveParamsExprParams(Params: TParamsExpr);
+var
+  ScopeDepth, i: integer;
+  ParamAccess: TResolvedRefAccess;
+  Pars: TPasExprArray;
+begin
+  ResetSubExprScopes(ScopeDepth);
+  if Params.Kind in [pekFuncParams,pekArrayParams] then
+    ParamAccess:=rraParamToUnknownProc
+  else
+    ParamAccess:=rraRead;
+  Pars:=Params.Params;
+  for i:=0 to length(Pars)-1 do
+    ResolveExpr(Pars[i],ParamAccess);
+  RestoreSubExprScopes(ScopeDepth);
+end;
+
 procedure TPasResolver.ResolveFuncParamsExpr(Params: TParamsExpr;
   Access: TResolvedRefAccess);
 var
@@ -9149,7 +9335,7 @@ begin
 end;
 
 procedure TPasResolver.ResolveFuncParamsExprName(NameExpr: TPasExpr;
-  Params: TParamsExpr; Access: TResolvedRefAccess);
+  Params: TParamsExpr; Access: TResolvedRefAccess; CallName: string);
 
   procedure FinishUntypedParams(ParamAccess: TResolvedRefAccess);
   var
@@ -9162,7 +9348,7 @@ procedure TPasResolver.ResolveFuncParamsExprName(NameExpr: TPasExpr;
 
 var
   i: Integer;
-  CallName, Msg: String;
+  Msg: String;
   FindCallData: TFindCallElData;
   Abort: boolean;
   El, FoundEl: TPasElement;
@@ -9174,7 +9360,8 @@ var
   C: TClass;
 begin
   // e.g. Name() -> find compatible
-  if NameExpr.ClassType=TPrimitiveExpr then
+  if CallName<>'' then
+  else if NameExpr.ClassType=TPrimitiveExpr then
     CallName:=TPrimitiveExpr(NameExpr).Value
   else
     RaiseNotYetImplemented(20190115143539,NameExpr);
@@ -15581,6 +15768,7 @@ begin
     else if AClass.InheritsFrom(TPasImplBlock) then
       // resolved when finished
     else if AClass=TPasImplCommand then
+    else if AClass=TPasAttributes then
     else if AClass=TPasUnresolvedUnitRef then
       RaiseMsg(20171018121900,nCantFindUnitX,sCantFindUnitX,[AName],El)
     else
@@ -15943,11 +16131,11 @@ var
   Proc: TPasProcedure;
   StartScope: TPasScope;
   OnlyTypeMembers, IsClassOf: Boolean;
-  TypeEl: TPasType;
   C: TClass;
   ClassRecScope: TPasClassOrRecordScope;
   i: Integer;
   AbstractProcs: TArrayOfPasProcedure;
+  TypeEl: TPasType;
 begin
   StartScope:=FindData.StartScope;
   OnlyTypeMembers:=false;
@@ -16091,10 +16279,14 @@ begin
         begin
         if ClassRecScope=nil then
           RaiseInternalError(20190123120156,GetObjName(StartScope));
-        TypeEl:=ClassRecScope.Element as TPasType;
+        TypeEl:=ClassRecScope.Element as TPasMembersType;
         if (TypeEl.ClassType=TPasClassType)
             and (TPasClassType(TypeEl).HelperForType<>nil) then
-          TypeEl:=ResolveAliasType(TPasClassType(TypeEl).HelperForType);
+          TypeEl:=ResolveAliasType(TPasClassType(TypeEl).HelperForType) as TPasType;
+        if (TypeEl.ClassType=TPasClassType) and
+            TPasClassType(TypeEl).IsAbstract then
+          LogMsg(20190224153450,mtWarning,nCreatingAnInstanceOfAbstractClassY,
+            sCreatingAnInstanceOfAbstractClassY,[TypeEl.Name],FindData.ErrorPosEl);
         TResolvedRefCtxConstructor(Ref.Context).Typ:=TypeEl;
         if OnlyTypeMembers and (ClassRecScope is TPasClassScope) then
           begin
@@ -22511,6 +22703,122 @@ begin
   Result:=false;
 end;
 
+function TPasResolver.IsCustomAttribute(El: TPasElement): boolean;
+var
+  ClassEl: TPasClassType;
+  ClassScope: TPasClassScope;
+  aModule: TPasModule;
+begin
+  Result:=false;
+  if (El=nil)
+      or (El.ClassType<>TPasClassType) then exit;
+  ClassEl:=TPasClassType(El);
+  if (ClassEl.IsExternal) or (ClassEl.ObjKind<>okClass) then exit;
+  while not SameText(ClassEl.Name,'TCustomAttribute') do
+    begin
+    ClassScope:=ClassEl.CustomData as TPasClassScope;
+    if ClassScope.AncestorScope=nil then exit;
+    ClassEl:=TPasClassType(ClassScope.AncestorScope.Element);
+    end;
+  if not (ClassEl.Parent is TPasSection) then
+    exit; // this TCustomAttribute is not top level
+  aModule:=ClassEl.GetModule;
+  Result:=IsSystemUnit(aModule);
+end;
+
+function TPasResolver.IsSystemUnit(El: TPasModule): boolean;
+var
+  Section: TPasSection;
+begin
+  Result:=false;
+  if El=nil then exit;
+  if SameText(El.Name,'system') then exit(true);
+
+  // tests and scripts are their own system unit: check if this is the root module
+  if El.ClassType=TPasProgram then
+    Section:=TPasProgram(El).ProgramSection
+  else if El.ClassType=TPasLibrary then
+    Section:=TPasLibrary(El).LibrarySection
+  else
+    Section:=El.InterfaceSection;
+  Result:=length(Section.UsesClause)=0;
+end;
+
+function TPasResolver.GetAttributeCallsEl(El: TPasElement): TPasExprArray;
+var
+  Parent: TPasElement;
+  C: TClass;
+  Members: TFPList;
+  i: Integer;
+begin
+  Result:=nil;
+  if El=nil then exit;
+  // find El in El.Parent members
+  Parent:=El.Parent;
+  if Parent=nil then exit;
+  C:=Parent.ClassType;
+  if C.InheritsFrom(TPasDeclarations) then
+    Members:=TPasDeclarations(Parent).Declarations
+  else if C.InheritsFrom(TPasMembersType) then
+    Members:=TPasMembersType(Parent).Members
+  else
+    exit;
+  i:=Members.IndexOf(El);
+  if i<0 then exit;
+  Result:=GetAttributeCalls(Members,i);
+end;
+
+function TPasResolver.GetAttributeCalls(Members: TFPList; Index: integer
+  ): TPasExprArray;
+
+  procedure AddAttributesInFront(Members: TFPList; i: integer);
+  var
+    j, l, k: Integer;
+    Calls: TPasExprArray;
+  begin
+    // find attributes in front
+    j:=i;
+    while (j>0) and (TPasElement(Members[j-1]).ClassType=TPasAttributes) do
+      dec(j);
+    // collect all attribute calls
+    l:=0;
+    while j<i do
+      begin
+      Calls:=TPasAttributes(Members[j]).Calls;
+      SetLength(Result,l+length(Calls));
+      for k:=0 to length(Calls)-1 do
+        begin
+        Result[l]:=Calls[k];
+        inc(l);
+        end;
+      inc(j);
+      end;
+  end;
+
+var
+  El, CurEl: TPasElement;
+begin
+  Result:=nil;
+  El:=TPasElement(Members[Index]);
+  AddAttributesInFront(Members,Index);
+  if (El.ClassType=TPasClassType) and (not TPasClassType(El).IsForward) then
+    repeat
+      dec(Index);
+      if Index<1 then break;
+      CurEl:=TPasElement(Members[Index]);
+      if (CurEl.ClassType=TPasClassType)
+          and TPasClassType(CurEl).IsForward
+          and (TPasClassType(CurEl).CustomData is TResolvedReference)
+          and (TResolvedReference(TPasClassType(CurEl).CustomData).Declaration=El)
+      then
+        begin
+        // class has a forward declaration -> add attributes
+        AddAttributesInFront(Members,Index);
+        break;
+        end;
+    until false;
+end;
+
 function TPasResolver.ProcNeedsParams(El: TPasProcedureType): boolean;
 begin
   Result:=(El.Args.Count>0) and (TPasArgument(El.Args[0]).ValueExpr=nil);

packages/fcl-passrc/src/pastree.pp

@@ -339,14 +339,15 @@ type
   public
     Declarations: TFPList; // list of TPasElement
     // Declarations contains all the following:
-    ResStrings, // TPasResString
-    Types,      // TPasType, except TPasClassType, TPasRecordType
-    Consts,     // TPasConst
+    Attributes, // TPasAttributes
     Classes,    // TPasClassType, TPasRecordType
+    Consts,     // TPasConst
+    ExportSymbols,// TPasExportSymbol
     Functions,  // TPasProcedure
-    Variables,  // TPasVariable, not descendants
     Properties, // TPasProperty
-    ExportSymbols  // TPasExportSymbol
+    ResStrings, // TPasResString
+    Types,      // TPasType, except TPasClassType, TPasRecordType
+    Variables   // TPasVariable, not descendants
       : TFPList;
   end;
 
@@ -979,6 +980,18 @@ type
     Function DefaultValue : string;
   end;
 
+  { TPasAttributes }
+
+  TPasAttributes = class(TPasElement)
+  public
+    destructor Destroy; override;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
+    procedure AddCall(Expr: TPasExpr);
+  public
+    Calls: TPasExprArray;
+  end;
+
   TProcType = (ptProcedure, ptFunction,
                ptOperator, ptClassOperator,
                ptConstructor, ptDestructor,
@@ -1218,6 +1231,17 @@ type
       const Arg: Pointer); override;
   end;
 
+  { TPasMethodResolution }
+
+  TPasMethodResolution = class(TPasElement)
+  public
+    destructor Destroy; override;
+  public
+    ProcClass: TPasProcedureClass;
+    InterfaceName: TPasExpr;
+    InterfaceProc: TPasExpr;
+    ImplementationProc: TPasExpr;
+  end;
 
   TPasImplBlock = class;
 
@@ -1233,18 +1257,6 @@ type
     Body: TPasImplBlock;
   end;
 
-  { TPasMethodResolution }
-
-  TPasMethodResolution = class(TPasElement)
-  public
-    destructor Destroy; override;
-  public
-    ProcClass: TPasProcedureClass;
-    InterfaceName: TPasExpr;
-    InterfaceProc: TPasExpr;
-    ImplementationProc: TPasExpr;
-  end;
-
   { TPasProcedureImpl - used by mkxmlrpc, not by pparser }
 
   TPasProcedureImpl = class(TPasElement)
@@ -1770,6 +1782,36 @@ begin
 end;
 {$ENDIF}
 
+{ TPasAttributes }
+
+destructor TPasAttributes.Destroy;
+var
+  i: Integer;
+begin
+  for i:=0 to length(Calls)-1 do
+    Calls[i].Release{$IFDEF CheckPasTreeRefCount}('TPasAttributes.Destroy'){$ENDIF};
+  inherited Destroy;
+end;
+
+procedure TPasAttributes.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+var
+  i: Integer;
+begin
+  inherited ForEachCall(aMethodCall, Arg);
+  for i:=0 to length(Calls)-1 do
+    ForEachChildCall(aMethodCall,Arg,Calls[i],false);
+end;
+
+procedure TPasAttributes.AddCall(Expr: TPasExpr);
+var
+  i : Integer;
+begin
+  i:=Length(Calls);
+  SetLength(Calls, i+1);
+  Calls[i]:=Expr;
+end;
+
 { TPasMethodResolution }
 
 destructor TPasMethodResolution.Destroy;
@@ -2740,14 +2782,15 @@ constructor TPasDeclarations.Create(const AName: string; AParent: TPasElement);
 begin
   inherited Create(AName, AParent);
   Declarations := TFPList.Create;
-  ResStrings := TFPList.Create;
-  Types := TFPList.Create;
-  Consts := TFPList.Create;
+  Attributes := TFPList.Create;
   Classes := TFPList.Create;
+  Consts := TFPList.Create;
+  ExportSymbols := TFPList.Create;
   Functions := TFPList.Create;
-  Variables := TFPList.Create;
   Properties := TFPList.Create;
-  ExportSymbols := TFPList.Create;
+  ResStrings := TFPList.Create;
+  Types := TFPList.Create;
+  Variables := TFPList.Create;
 end;
 
 destructor TPasDeclarations.Destroy;
@@ -2756,14 +2799,15 @@ var
   Child: TPasElement;
 begin
   {$IFDEF VerbosePasTreeMem}writeln('TPasDeclarations.Destroy START');{$ENDIF}
-  FreeAndNil(ExportSymbols);
-  FreeAndNil(Properties);
   FreeAndNil(Variables);
-  FreeAndNil(Functions);
-  FreeAndNil(Classes);
-  FreeAndNil(Consts);
   FreeAndNil(Types);
   FreeAndNil(ResStrings);
+  FreeAndNil(Properties);
+  FreeAndNil(Functions);
+  FreeAndNil(ExportSymbols);
+  FreeAndNil(Consts);
+  FreeAndNil(Classes);
+  FreeAndNil(Attributes);
   {$IFDEF VerbosePasTreeMem}writeln('TPasDeclarations.Destroy Declarations');{$ENDIF}
   for i := 0 to Declarations.Count - 1 do
     begin

packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -255,6 +255,7 @@ type
     procedure UseElement(El: TPasElement; Access: TResolvedRefAccess;
       UseFull: boolean); virtual;
     procedure UseTypeInfo(El: TPasElement); virtual;
+    procedure UseAttributes(El: TPasElement); virtual;
     function UseModule(aModule: TPasModule; Mode: TPAUseMode): boolean; virtual;
     procedure UseSection(Section: TPasSection; Mode: TPAUseMode); virtual;
     procedure UseImplBlock(Block: TPasImplBlock; Mark: boolean); virtual;
@@ -1116,6 +1117,8 @@ begin
       for i:=0 to Members.Count-1 do
         begin
         Member:=TPasElement(Members[i]);
+        if Member.ClassType=TPasAttributes then
+          continue;
         if IsUsed(Member) then
           UseTypeInfo(Member);
         end;
@@ -1129,6 +1132,8 @@ begin
     for i:=0 to Members.Count-1 do
       begin
       Member:=TPasElement(Members[i]);
+      if Member.ClassType=TPasAttributes then
+        continue; // attributes are never used directly
       UseSubEl(Member);
       end;
     end
@@ -1151,6 +1156,18 @@ begin
     end;
 
   UseElement(El,rraNone,true);
+
+  UseAttributes(El);
+end;
+
+procedure TPasAnalyzer.UseAttributes(El: TPasElement);
+var
+  Calls: TPasExprArray;
+  i: Integer;
+begin
+  Calls:=Resolver.GetAttributeCallsEl(El);
+  for i:=0 to length(Calls)-1 do
+    UseExpr(Calls[i]);
 end;
 
 function TPasAnalyzer.UseModule(aModule: TPasModule; Mode: TPAUseMode): boolean;
@@ -1281,6 +1298,8 @@ begin
       end
     else if C=TPasResString then
       UseResourcestring(TPasResString(Decl))
+    else if C=TPasAttributes then
+      // attributes are never used directly
     else
       RaiseNotSupported(20170306165213,Decl);
     end;
@@ -1470,6 +1489,12 @@ begin
     MarkImplScopeRef(El,Decl,ResolvedToPSRefAccess[Access]);
     UseElement(Decl,Access,false);
 
+    if Ref.Context<>nil then
+      begin
+      if Ref.Context.ClassType=TResolvedRefCtxAttrProc then
+        UseProcedure(TResolvedRefCtxAttrProc(Ref.Context).Proc);
+      end;
+
     if Resolver.IsNameExpr(El) then
       begin
       if Ref.WithExprScope<>nil then
@@ -2082,7 +2107,10 @@ begin
         end;
         //writeln('TPasAnalyzer.UseClassType ',El.FullName,' ',Mode,' ',Member.Name);
         end;
-      end;
+      end
+    else if Member.ClassType=TPasAttributes then
+      continue; // attributes are never used directly
+
     if AllPublished and (Member.Visibility=visPublished) then
       begin
       // include published
@@ -2442,6 +2470,8 @@ begin
       EmitTypeHints(TPasType(Decl))
     else if Decl is TPasProcedure then
       EmitProcedureHints(TPasProcedure(Decl))
+    else if Decl.ClassType=TPasAttributes then
+      // no hints
     else
       begin
       Usage:=FindElement(Decl);
@@ -2461,6 +2491,7 @@ var
   Usage: TPAElement;
   i: Integer;
   Member: TPasElement;
+  Members: TFPList;
 begin
   {$IFDEF VerbosePasAnalyzer}
   writeln('TPasAnalyzer.EmitTypeHints ',GetElModName(El));
@@ -2483,21 +2514,22 @@ begin
     exit;
     end;
   // emit hints for sub elements
+  Members:=nil;
   C:=El.ClassType;
   if C=TPasRecordType then
-    begin
-    for i:=0 to TPasRecordType(El).Members.Count-1 do
-      EmitVariableHints(TObject(TPasRecordType(El).Members[i]) as TPasVariable);
-    end
+    Members:=TPasRecordType(El).Members
   else if C=TPasClassType then
     begin
     if TPasClassType(El).IsForward then exit;
-    for i:=0 to TPasClassType(El).Members.Count-1 do
+    Members:=TPasClassType(El).Members;
+    end;
+  if Members<>nil then
+    for i:=0 to Members.Count-1 do
       begin
-      Member:=TPasElement(TPasClassType(El).Members[i]);
+      Member:=TPasElement(Members[i]);
+      if Member.ClassType=TPasAttributes then continue;
       EmitElementHints(Member);
       end;
-    end;
 end;
 
 procedure TPasAnalyzer.EmitVariableHints(El: TPasVariable);

packages/fcl-passrc/src/pparser.pp

@@ -174,7 +174,7 @@ type
     stWithExpr, // calls BeginScope after parsing every WITH-expression
     stExceptOnExpr,
     stExceptOnStatement,
-    stDeclaration, // e.g. a TPasProperty, TPasVariable, TPasArgument
+    stDeclaration, // e.g. a TPasProperty, TPasVariable, TPasArgument, ...
     stAncestors, // the list of ancestors and interfaces of a class
     stInitialFinalization
     );
@@ -426,7 +426,7 @@ type
     // Constant declarations
     function ParseConstDecl(Parent: TPasElement): TPasConst;
     function ParseResourcestringDecl(Parent: TPasElement): TPasResString;
-    procedure ParseAttribute(Parent: TPasElement);
+    function ParseAttributes(Parent: TPasElement): TPasAttributes;
     // Variable handling. This includes parts of records
     procedure ParseVarDecl(Parent: TPasElement; List: TFPList);
     procedure ParseInlineVarDecl(Parent: TPasElement; List: TFPList;  AVisibility : TPasMemberVisibility  = visDefault; ClosingBrace: Boolean = False);
@@ -3323,7 +3323,6 @@ var
   ArrEl : TPasArrayType;
   List: TFPList;
   i,j: Integer;
-  VarEl: TPasVariable;
   ExpEl: TPasExportSymbol;
   PropEl : TPasProperty;
   TypeName: String;
@@ -3332,6 +3331,8 @@ var
   ok: Boolean;
   Proc: TPasProcedure;
   RecordEl: TPasRecordType;
+  Attr: TPasAttributes;
+  CurEl: TPasElement;
 begin
   CurBlock := declNone;
   HadTypeSection:=false;
@@ -3512,10 +3513,13 @@ begin
                 ParseVarDecl(Declarations, List);
                 for i := 0 to List.Count - 1 do
                 begin
-                  VarEl := TPasVariable(List[i]);
-                  Declarations.Declarations.Add(VarEl);
-                  Declarations.Variables.Add(VarEl);
-                  Engine.FinishScope(stDeclaration,VarEl);
+                  CurEl := TPasElement(List[i]);
+                  Declarations.Declarations.Add(CurEl);
+                  if CurEl.ClassType=TPasAttributes then
+                    Declarations.Attributes.Add(CurEl)
+                  else
+                    Declarations.Variables.Add(TPasVariable(CurEl));
+                  Engine.FinishScope(stDeclaration,CurEl);
                 end;
                 CheckToken(tkSemicolon);
               finally
@@ -3671,8 +3675,13 @@ begin
         ParseLabels(Declarations);
       end;
     tkSquaredBraceOpen:
-      if [msPrefixedAttributes,msIgnoreAttributes]*CurrentModeSwitches<>[] then
-        ParseAttribute(Declarations)
+      if msPrefixedAttributes in CurrentModeSwitches then
+        begin
+        Attr:=ParseAttributes(Declarations);
+        Declarations.Declarations.Add(Attr);
+        Declarations.Attributes.Add(Attr);
+        Engine.FinishScope(stDeclaration,Attr);
+        end
       else
         ParseExcSyntaxError;
     else
@@ -3949,32 +3958,53 @@ begin
   end;
 end;
 
-procedure TPasParser.ParseAttribute(Parent: TPasElement);
+function TPasParser.ParseAttributes(Parent: TPasElement): TPasAttributes;
 var
-  Expr: TPasExpr;
+  Expr, Arg: TPasExpr;
+  Attributes: TPasAttributes;
+  Params: TParamsExpr;
 begin
-  repeat
-    // skip attribute
-    // [name,name(param,param,...),...]
-    // [name(param,name=param)]
+  Result:=nil;
+  Attributes:=TPasAttributes(CreateElement(TPasAttributes,'',Parent));
+  try
     repeat
-      ExpectIdentifier;
       NextToken;
-    until CurToken<>tkDot;
-    if CurToken=tkBraceOpen then
-      begin
-      repeat
+      // [name,name(param,param,...),...]
+      Expr:=nil;
+      ReadDottedIdentifier(Attributes,Expr,false);
+      if CurToken=tkBraceOpen then
+        begin
+        Params:=TParamsExpr(CreateElement(TParamsExpr,'',Attributes));
+        Params.Kind:=pekFuncParams;
+        Attributes.AddCall(Params);
+        Params.Value:=Expr;
+        Expr.Parent:=Params;
+        Expr:=nil;
+        repeat
+          NextToken;
+          if CurToken=tkBraceClose then
+            break;
+          Arg:=DoParseConstValueExpression(Params);
+          Params.AddParam(Arg);
+        until CurToken<>tkComma;
+        CheckToken(tkBraceClose);
         NextToken;
-        if CurToken=tkBraceClose then
-          break;
-        Expr:=DoParseConstValueExpression(Parent);
-        Expr.Free;
-      until CurToken<>tkComma;
-      CheckToken(tkBraceClose);
-      NextToken;
+        end
+      else
+        begin
+        Attributes.AddCall(Expr);
+        Expr:=nil;
+        end;
+    until CurToken<>tkComma;
+    CheckToken(tkSquaredBraceClose);
+    Result:=Attributes;
+  finally
+    if Result=nil then
+      begin
+      Attributes.Free;
+      Expr.Free;
       end;
-  until CurToken<>tkComma;
-  CheckToken(tkSquaredBraceClose);
+  end;
 end;
 
 procedure TPasParser.ReadGenericArguments(List: TFPList; Parent: TPasElement);
@@ -4355,6 +4385,13 @@ begin
   try
     D:=SaveComments; // This means we support only one comment per 'list'.
     VarEl:=nil;
+    while CurToken=tkSquaredBraceOpen do
+      begin
+      if msPrefixedAttributes in CurrentModeswitches then
+        VarList.Add(ParseAttributes(Parent))
+      else
+        CheckToken(tkIdentifier);
+      end;
     Repeat
       // create the TPasVariable here, so that SourceLineNumber is correct
       VarEl:=TPasVariable(CreateElement(TPasVariable,CurTokenString,Parent,
@@ -5097,7 +5134,7 @@ begin
       end
     else if (CurToken = tkSquaredBraceOpen) then
       begin
-      if ([msPrefixedAttributes,msIgnoreAttributes]*CurrentModeswitches<>[]) then
+      if msPrefixedAttributes in CurrentModeswitches then
         begin
         // [attribute]
         UngetToken;
@@ -6346,6 +6383,8 @@ Var
   isClass : Boolean;
   NamePos: TPasSourcePos;
   OldCount, i: Integer;
+  CurEl: TPasElement;
+  Attr: TPasAttributes;
 begin
   if AllowMethods then
     v:=visPublic
@@ -6379,10 +6418,12 @@ begin
         ParseInlineVarDecl(ARec, ARec.Members, v, AEndToken=tkBraceClose);
         for i:=OldCount to ARec.Members.Count-1 do
           begin
+          CurEl:=TPasElement(ARec.Members[i]);
+          if CurEl.ClassType=TPasAttributes then continue;
           if isClass then
-            With TPasVariable(ARec.Members[i]) do
+            With TPasVariable(CurEl) do
               VarModifiers:=VarModifiers + [vmClass];
-          Engine.FinishScope(stDeclaration,TPasVariable(ARec.Members[i]));
+          Engine.FinishScope(stDeclaration,TPasVariable(CurEl));
           end;
         end;
       tkClass:
@@ -6427,7 +6468,7 @@ begin
         end;
       tkDestructor:
         ParseExc(nParserNoConstructorAllowed,SParserNoConstructorAllowed);
-      tkGeneric, // Counts as field name
+      tkGeneric,tkSelf, // Counts as field name
       tkIdentifier :
         begin
         If AllowMethods and CheckVisibility(CurTokenString,v) then
@@ -6440,8 +6481,21 @@ begin
         OldCount:=ARec.Members.Count;
         ParseInlineVarDecl(ARec, ARec.Members, v, AEndToken=tkBraceClose);
         for i:=OldCount to ARec.Members.Count-1 do
-          Engine.FinishScope(stDeclaration,TPasVariable(ARec.Members[i]));
+          begin
+          CurEl:=TPasElement(ARec.Members[i]);
+          if CurEl.ClassType=TPasAttributes then continue;
+          Engine.FinishScope(stDeclaration,TPasVariable(CurEl));
+          end;
         end;
+      tkSquaredBraceOpen:
+        if msPrefixedAttributes in CurrentModeswitches then
+          begin
+          Attr:=ParseAttributes(ARec);
+          ARec.Members.Add(Attr);
+          Engine.FinishScope(stDeclaration,Attr);
+          end
+        else
+          CheckToken(tkIdentifier);
       tkCase :
         begin
         ARec.Variants:=TFPList.Create;
@@ -6670,7 +6724,7 @@ Var
   LastToken: TToken;
   PropEl: TPasProperty;
   MethodRes: TPasMethodResolution;
-
+  Attr: TPasAttributes;
 begin
   CurSection:=stNone;
   haveClass:=false;
@@ -6829,8 +6883,12 @@ begin
         HaveClass:=False;
         end;
       tkSquaredBraceOpen:
-        if [msPrefixedAttributes,msIgnoreAttributes]*CurrentModeswitches<>[] then
-          ParseAttribute(AType)
+        if msPrefixedAttributes in CurrentModeswitches then
+          begin
+          Attr:=ParseAttributes(AType);
+          AType.Members.Add(Attr);
+          Engine.FinishScope(stDeclaration,Attr);
+          end
         else
           CheckToken(tkIdentifier);
     else

packages/fcl-passrc/src/pscanner.pp

@@ -293,7 +293,6 @@ type
     msArrayOperators,      { use Delphi compatible array operators instead of custom ones ("+") }
     msExternalClass,       { Allow external class definitions }
     msPrefixedAttributes,  { Allow attributes, disable proc modifier [] }
-    msIgnoreAttributes,    { workaround til resolver/converter supports attributes }
     msOmitRTTI,            { treat class section 'published' as 'public' and typeinfo does not work on symbols declared with this switch }
     msMultipleScopeHelpers { off=only one helper per type, on=all }
     );
@@ -1038,7 +1037,6 @@ const
     'ARRAYOPERATORS',
     'EXTERNALCLASS',
     'PREFIXEDATTRIBUTES',
-    'IGNOREATTRIBUTES',
     'OMITRTTI',
     'MULTIPLESCOPEHELPERS'
     );

packages/fcl-passrc/tests/tcresolver.pas

@@ -149,6 +149,7 @@ type
     procedure CheckParserException(Msg: string; MsgNumber: integer);
     procedure CheckAccessMarkers; virtual;
     procedure CheckParamsExpr_pkSet_Markers; virtual;
+    procedure CheckAttributeMarkers; virtual;
     procedure GetSrc(Index: integer; out SrcLines: TStringList; out aFilename: string);
     function FindElementsAt(aFilename: string; aLine, aStartCol, aEndCol: integer): TFPList;// list of TPasElement
     function FindElementsAt(aMarker: PSrcMarker; ErrorOnNoElements: boolean = true): TFPList;// list of TPasElement
@@ -608,6 +609,7 @@ type
     Procedure TestClass_UntypedParam_TypeCast;
     Procedure TestClass_Sealed;
     Procedure TestClass_SealedDescendFail;
+    Procedure TestClass_AbstractCreateFail;
     Procedure TestClass_VarExternal;
     Procedure TestClass_WarnOverrideLowerVisibility;
     Procedure TestClass_Const;
@@ -931,7 +933,10 @@ type
     Procedure TestTypeHelper_InterfaceFail;
 
     // attributes
-    Procedure TestAttributes_Ignore;
+    Procedure TestAttributes_Globals;
+    Procedure TestAttributes_NonConstParam_Fail;
+    Procedure TestAttributes_UnknownAttrWarning;
+    Procedure TestAttributes_Members;
   end;
 
 function LinesToStr(Args: array of const): string;
@@ -1845,6 +1850,107 @@ begin
     end;
 end;
 
+procedure TCustomTestResolver.CheckAttributeMarkers;
+// check markers of the form {#Attr__ClassMarker__ConstructorMarker[__OptionalName]}
+var
+  aMarker, ClassMarker, ConstructorMarker: PSrcMarker;
+  Elements: TFPList;
+  i: Integer;
+  El: TPasElement;
+  Ref: TResolvedReference;
+  s, ClassMarkerName, ConstructorMarkerName: String;
+  p: SizeInt;
+  ExpectedClass: TPasClassType;
+  ExpectedConstrucor, ActualConstructor: TPasConstructor;
+begin
+  aMarker:=FirstSrcMarker;
+  while aMarker<>nil do
+    begin
+    s:=aMarker^.Identifier;
+    if SameText(LeftStr(s,6),'Attr__') then
+      begin
+      //writeln('TCustomTestResolver.CheckAttributeMarkers ',aMarker^.Identifier,' ',aMarker^.StartCol,' ',aMarker^.EndCol);
+      Delete(s,1,6);
+      p:=Pos('__',s);
+      if p<1 then
+        RaiseErrorAtSrcMarker('missing second __ at "#'+aMarker^.Identifier+'"',aMarker);
+      ClassMarkerName:=LeftStr(s,p-1);
+      Delete(s,1,p+1);
+      p:=Pos('__',s);
+      if p<1 then
+        ConstructorMarkerName:=s
+      else
+        ConstructorMarkerName:=copy(s,1,p-1);
+
+      // find attribute class at ClassMarkerName
+      ClassMarker:=FindSrcLabel(ClassMarkerName);
+      if ClassMarker=nil then
+        RaiseErrorAtSrcMarker('ClassMarker "'+ClassMarkerName+'" not found at "#'+aMarker^.Identifier+'"',aMarker);
+      ExpectedClass:=nil;
+      Elements:=FindElementsAt(ClassMarker);
+      try
+        for i:=0 to Elements.Count-1 do
+          begin
+          El:=TPasElement(Elements[i]);
+          if El is TPasClassType then
+            begin
+            ExpectedClass:=TPasClassType(El);
+            break;
+            end;
+          end;
+        if ExpectedClass=nil then
+          RaiseErrorAtSrcMarker('ClassMarker "'+ClassMarkerName+'" at "#'+aMarker^.Identifier+'" has no TPasClassType',aMarker);
+      finally
+        Elements.Free;
+      end;
+
+      // find constructor at ConstructorMarkerName
+      ConstructorMarker:=FindSrcLabel(ConstructorMarkerName);
+      if ConstructorMarker=nil then
+        RaiseErrorAtSrcMarker('ConstructorMarker "'+ConstructorMarkerName+'" not found at "#'+aMarker^.Identifier+'"',aMarker);
+      ExpectedConstrucor:=nil;
+      Elements:=FindElementsAt(ConstructorMarker);
+      try
+        for i:=0 to Elements.Count-1 do
+          begin
+          El:=TPasElement(Elements[i]);
+          if El is TPasConstructor then
+            begin
+            ExpectedConstrucor:=TPasConstructor(El);
+            break;
+            end;
+          end;
+        if ExpectedConstrucor=nil then
+          RaiseErrorAtSrcMarker('ConstructorMarker "'+ConstructorMarkerName+'" at "#'+aMarker^.Identifier+'" has no TPasConstructor',aMarker);
+      finally
+        Elements.Free;
+      end;
+
+      Elements:=FindElementsAt(aMarker);
+      try
+        for i:=0 to Elements.Count-1 do
+          begin
+          El:=TPasElement(Elements[i]);
+          //writeln('TCustomTestResolver.CheckAttributeMarkers ',aMarker^.Identifier,' ',i,'/',Elements.Count,' El=',GetObjName(El),' ',GetObjName(El.CustomData));
+          if not (El.CustomData is TResolvedReference) then continue;
+          Ref:=TResolvedReference(El.CustomData);
+          if Ref.Declaration<>ExpectedClass then
+            RaiseErrorAtSrcMarker('Ref.Declaration at "#'+aMarker^.Identifier+'", expected "'+ExpectedClass.FullName+'" but found "'+Ref.Declaration.FullName+'", El='+GetObjName(El),aMarker);
+          if not (Ref.Context is TResolvedRefCtxAttrProc) then
+            RaiseErrorAtSrcMarker('Ref.Context at "#'+aMarker^.Identifier+'", expected "TResolvedRefCtxAttrConstructor" but found "'+GetObjName(Ref.Context)+'", El='+GetObjName(El),aMarker);
+          ActualConstructor:=TResolvedRefCtxAttrProc(Ref.Context).Proc;
+          if ActualConstructor<>ExpectedConstrucor then
+            RaiseErrorAtSrcMarker('Ref.Context.Proc at "#'+aMarker^.Identifier+'", expected "'+ExpectedConstrucor.FullName+'" but found "'+ActualConstructor.FullName+'", El='+GetObjName(El),aMarker);
+          break;
+          end;
+      finally
+        Elements.Free;
+      end;
+      end;
+    aMarker:=aMarker^.Next;
+    end;
+end;
+
 procedure TCustomTestResolver.GetSrc(Index: integer; out SrcLines: TStringList; out
   aFilename: string);
 var
@@ -10730,6 +10836,26 @@ begin
     nCannotCreateADescendantOfTheSealedXY);
 end;
 
+procedure TTestResolver.TestClass_AbstractCreateFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '    constructor Create;',
+  '  end;',
+  '  TNop = class abstract(TObject)',
+  '  end;',
+  'constructor TObject.Create;',
+  'begin',
+  'end;',
+  'begin',
+  '  TNop.Create;']);
+  ParseProgram;
+  CheckResolverHint(mtWarning,nCreatingAnInstanceOfAbstractClassY,
+    'Creating an instance of abstract class "TNop"');
+end;
+
 procedure TTestResolver.TestClass_VarExternal;
 begin
   StartProgram(false);
@@ -17422,32 +17548,107 @@ begin
   CheckResolverException('Type "IUnknown" cannot be extended by a type helper',nTypeXCannotBeExtendedByATypeHelper);
 end;
 
-procedure TTestResolver.TestAttributes_Ignore;
+procedure TTestResolver.TestAttributes_Globals;
 begin
   StartProgram(false);
   Add([
-  '{$modeswitch IgnoreAttributes}',
+  '{$modeswitch prefixedattributes}',
   'type',
-  '  [custom1, custom2(1+3,''foo'')] [mod1.custom3]',
   '  TObject = class',
-  '    [custom5()] FS: string;',
-  '    [customProp] property S: string read FS;',
+  '    constructor {#TObject_Create}Create;',
   '  end;',
-  '  TOnGetCellClass = procedure(Sender: TObject; ACol, ARow:',
-  '   longint; var CellClassType: TObject) of object;',
-  '  [Attr]',
-  '  TBird = class(TObject)',
+  '  {#Custom}TCustomAttribute = class',
+  '  end;',
+  '  {#Red}RedAttribute = class(TCustomAttribute)',
+  '    constructor {#Red_A}Create(Id: word = 3; Deep: boolean = false); overload;',
+  '    constructor {#Red_B}Create(Size: double); overload;',
+  '  end;',
+  '  Red = word;',
+  'constructor TObject.Create; begin end;',
+  'constructor RedAttribute.Create(Id: word; Deep: boolean); begin end;',
+  'constructor RedAttribute.Create(Size: double); begin end;',
+  'var',
+  '  [{#Attr__Custom__TObject_Create}TCustom]',
+  '  [{#Attr__Red__Red_A__1}Red,afile.{#Attr__Red__Red_A__2}Red]',
+  '  o: TObject;',
+  'const',
+  '  [{#Attr__Red__Red_B}RedAttribute(1.3)]',
+  '  c = 3;',
+  'begin',
+  '']);
+  ParseProgram;
+  CheckAttributeMarkers;
+  CheckResolverUnexpectedHints;
+end;
+
+procedure TTestResolver.TestAttributes_NonConstParam_Fail;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch prefixedattributes}',
+  'type',
+  '  TObject = class',
+  '    constructor Create(w: word);',
+  '  end;',
+  '  TCustomAttribute = class',
   '  end;',
-  '[Attr]',
-  'procedure DoA; forward;',
-  '[Attr]',
-  'procedure DoA; begin end;',
+  'constructor TObject.Create(w: word);',
+  'begin',
+  'end;',
   'var',
-  '  [custom6]',
+  '  w: word;',
+  '  [TCustom(w)]',
   '  o: TObject;',
   'begin',
   '']);
+  CheckResolverException(sConstantExpressionExpected,nConstantExpressionExpected);
+end;
+
+procedure TTestResolver.TestAttributes_UnknownAttrWarning;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch prefixedattributes}',
+  'type',
+  '  TObject = class',
+  '  end;',
+  '  TCustomAttribute = class',
+  '  end;',
+  'var',
+  '  [Red]',
+  '  o: TObject;',
+  'begin',
+  '']);
+  ParseProgram;
+  CheckResolverHint(mtWarning,nUnknownCustomAttributeX,'Unknown custom attribute "Red"');
+end;
+
+procedure TTestResolver.TestAttributes_Members;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch prefixedattributes}',
+  'type',
+  '  TObject = class',
+  '    constructor {#create}Create;',
+  '  end;',
+  '  {#custom}TCustomAttribute = class',
+  '  end;',
+  '  TMyClass = class',
+  '    [{#attr__custom__create__cl}TCustom]',
+  '    Field: word;',
+  '  end;',
+  '  TMyRecord = record',
+  '    [{#attr__custom__create__rec}TCustom]',
+  '    Field: word;',
+  '  end;',
+  'constructor TObject.Create;',
+  'begin',
+  'end;',
+  'begin',
+  '']);
   ParseProgram;
+  CheckAttributeMarkers;
 end;
 
 initialization

packages/fcl-passrc/tests/tcuseanalyzer.pas

@@ -166,6 +166,8 @@ type
     procedure TestWP_ClassInterface_TGUID;
     procedure TestWP_ClassHelper;
     procedure TestWP_ClassHelper_ClassConstrucor_Used;
+    procedure TestWP_Attributes;
+    procedure TestWP_Attributes_ForwardClass;
 
     // scope references
     procedure TestSR_Proc_UnitVar;
@@ -3151,6 +3153,57 @@ begin
   AnalyzeWholeProgram;
 end;
 
+procedure TTestUseAnalyzer.TestWP_Attributes;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch prefixedattributes}',
+  'type',
+  '  TObject = class',
+  '    constructor {#TObject_Create_notused}Create;',
+  '  end;',
+  '  {#TCustomAttribute_used}TCustomAttribute = class',
+  '  end;',
+  '  {#RedAttribute_used}RedAttribute = class(TCustomAttribute)',
+  '    constructor {#Red_A_used}Create(Id: word = 3; Deep: boolean = false); overload;',
+  '    constructor {#Red_B_notused}Create(Size: double); overload;',
+  '  end;',
+  '  {#Red_notused}Red = word;',
+  'constructor TObject.Create; begin end;',
+  'constructor RedAttribute.Create(Id: word; Deep: boolean); begin end;',
+  'constructor RedAttribute.Create(Size: double); begin end;',
+  'var',
+  '  [NotExisting]',
+  '  [Red]',
+  '  o: TObject;',
+  'begin',
+  '  if typeinfo(o)=nil then ;',
+  '']);
+  AnalyzeWholeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestWP_Attributes_ForwardClass;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch prefixedattributes}',
+  'type',
+  '  TObject = class',
+  '    constructor {#TObject_Create_used}Create;',
+  '  end;',
+  '  {#TCustomAttribute_used}TCustomAttribute = class',
+  '  end;',
+  '  [TCustom]',
+  '  TBird = class;',
+  '  TMyInt = word;',
+  '  TBird = class end;',
+  'constructor TObject.Create; begin end;',
+  'begin',
+  '  if typeinfo(TBird)=nil then ;',
+  '']);
+  AnalyzeWholeProgram;
+end;
+
 procedure TTestUseAnalyzer.TestSR_Proc_UnitVar;
 begin
   StartUnit(false);

packages/fcl-web/examples/restbridge/README.txt

@@ -0,0 +1,25 @@
+This is a demo for the SQLDB REST Bridge.
+
+It requires a database. The database can be created using the
+expenses-DB.sql file (replace DB with the appropriate type) 
+
+Sample data can be inserted with the expenses-data.sql file.
+
+You must edit the program to provide the correct database credentials: 
+look for the ExposeDatabase() call, and edit the username/password.
+
+You must also change the name and location of the database.
+
+You can also set the port on which the demo should listen for HTTP requests.
+By default it is 3000.
+
+The program can save the connection data to an .ini file, run it with -s
+myfile.ini. The connection data and database schema will then be saved.
+
+It can pick up the connection data and schema with the -c myfile.ini
+command-line options at a next run.
+
+
+Enjoy !
+
+Michael.

packages/fcl-web/examples/restbridge/delphiclient/frmmain.dfm

@@ -0,0 +1,129 @@
+object Form1: TForm1
+  Left = 0
+  Top = 0
+  Caption = 'SQLDB Rest client demo'
+  ClientHeight = 319
+  ClientWidth = 527
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'Tahoma'
+  Font.Style = []
+  OldCreateOrder = False
+  DesignSize = (
+    527
+    319)
+  PixelsPerInch = 96
+  TextHeight = 13
+  object Label1: TLabel
+    Left = 16
+    Top = 8
+    Width = 158
+    Height = 13
+    Caption = 'SQLDBRest bridge resource URL:'
+  end
+  object Label2: TLabel
+    Left = 16
+    Top = 54
+    Width = 48
+    Height = 13
+    Caption = 'Username'
+  end
+  object LEPassword: TLabel
+    Left = 172
+    Top = 54
+    Width = 46
+    Height = 13
+    Caption = 'Password'
+    FocusControl = EPassword
+  end
+  object DBNavigator1: TDBNavigator
+    Left = 16
+    Top = 81
+    Width = 240
+    Height = 25
+    DataSource = DSRest
+    TabOrder = 0
+  end
+  object DBGrid1: TDBGrid
+    Left = 16
+    Top = 112
+    Width = 498
+    Height = 199
+    Anchors = [akLeft, akTop, akRight, akBottom]
+    DataSource = DSRest
+    TabOrder = 1
+    TitleFont.Charset = DEFAULT_CHARSET
+    TitleFont.Color = clWindowText
+    TitleFont.Height = -11
+    TitleFont.Name = 'Tahoma'
+    TitleFont.Style = []
+  end
+  object EURL: TEdit
+    Left = 16
+    Top = 24
+    Width = 417
+    Height = 21
+    Anchors = [akLeft, akTop, akRight]
+    TabOrder = 2
+    Text = 'http://192.168.0.98:3000/projects/'
+  end
+  object BFetch: TButton
+    Left = 439
+    Top = 22
+    Width = 75
+    Height = 25
+    Anchors = [akTop, akRight]
+    Caption = 'Fetch data'
+    TabOrder = 3
+    OnClick = BFetchClick
+  end
+  object EUserName: TEdit
+    Left = 70
+    Top = 51
+    Width = 96
+    Height = 21
+    Anchors = [akLeft, akTop, akRight]
+    TabOrder = 4
+    Text = 'Michael'
+  end
+  object EPassword: TEdit
+    Left = 224
+    Top = 51
+    Width = 134
+    Height = 21
+    Anchors = [akLeft, akTop, akRight]
+    PasswordChar = '*'
+    TabOrder = 5
+    Text = 'secret'
+  end
+  object DSRest: TDataSource
+    DataSet = CDSRest
+    Left = 72
+    Top = 128
+  end
+  object CDSRest: TClientDataSet
+    Aggregates = <>
+    Params = <>
+    Left = 128
+    Top = 128
+  end
+  object RestClient: TIdHTTP
+    AllowCookies = True
+    ProxyParams.BasicAuthentication = False
+    ProxyParams.ProxyPort = 0
+    Request.ContentLength = -1
+    Request.ContentRangeEnd = -1
+    Request.ContentRangeStart = -1
+    Request.ContentRangeInstanceLength = -1
+    Request.Accept = 'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8'
+    Request.BasicAuthentication = False
+    Request.UserAgent = 'Mozilla/3.0 (compatible; Indy Library)'
+    Request.Ranges.Units = 'bytes'
+    Request.Ranges = <>
+    HTTPOptions = [hoInProcessAuth, hoForceEncodeParams]
+    Left = 200
+    Top = 128
+  end
+end

packages/fcl-web/examples/restbridge/delphiclient/frmmain.pas

@@ -0,0 +1,66 @@
+unit frmmain;
+
+interface
+
+uses
+  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
+  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Data.DB, IPPeerClient, REST.Client,
+  REST.Authenticator.Basic, Data.Bind.Components, Data.Bind.ObjectScope,
+  Vcl.StdCtrls, Vcl.Grids, Vcl.DBGrids, Vcl.ExtCtrls, Vcl.DBCtrls,
+  Datasnap.DBClient, System.Net.URLClient, System.Net.HttpClient,
+  System.Net.HttpClientComponent, IdBaseComponent, IdComponent, IdTCPConnection,
+  IdTCPClient, IdHTTP;
+
+type
+  TForm1 = class(TForm)
+    DSRest: TDataSource;
+    CDSRest: TClientDataSet;
+    DBNavigator1: TDBNavigator;
+    DBGrid1: TDBGrid;
+    EURL: TEdit;
+    BFetch: TButton;
+    Label1: TLabel;
+    Label2: TLabel;
+    EUserName: TEdit;
+    LEPassword: TLabel;
+    EPassword: TEdit;
+    RestClient: TIdHTTP;
+    procedure BFetchClick(Sender: TObject);
+  private
+    { Private declarations }
+  public
+    { Public declarations }
+  end;
+
+var
+  Form1: TForm1;
+
+implementation
+
+{$R *.dfm}
+
+procedure TForm1.BFetchClick(Sender: TObject);
+
+Var
+  URL : String;
+  Response : TMemoryStream;
+
+begin
+  URL:=EURL.Text;
+  if Pos('?',URL)=0 then
+    URL:=URL+'?'
+  else
+    URL:=URL+'&';
+  URL:=URL+'fmt=cds';
+  Response:=TMemoryStream.Create;
+  With RestClient.Request do
+    begin
+    UserName:=EUserName.Text;
+    Password:=EPassword.Text;
+    end;
+  RestClient.Get(URL,Response);
+  Response.Position:=0;
+  CDSRest.LoadFromStream(Response);
+end;
+
+end.

packages/fcl-web/examples/restbridge/delphiclient/sqldbrestclient.dpr

@@ -0,0 +1,14 @@
+program sqldbrestclient;
+
+uses
+  Vcl.Forms,
+  frmmain in 'frmmain.pas' {Form1};
+
+{$R *.res}
+
+begin
+  Application.Initialize;
+  Application.MainFormOnTaskbar := True;
+  Application.CreateForm(TForm1, Form1);
+  Application.Run;
+end.

packages/fcl-web/examples/restbridge/delphiclient/sqldbrestclient.dproj

@@ -0,0 +1,560 @@
+<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
+    <PropertyGroup>
+        <ProjectGuid>{7D8C7C45-76FE-4285-B7B8-E1D0E65A6829}</ProjectGuid>
+        <ProjectVersion>18.3</ProjectVersion>
+        <FrameworkType>VCL</FrameworkType>
+        <MainSource>sqldbrestclient.dpr</MainSource>
+        <Base>True</Base>
+        <Config Condition="'$(Config)'==''">Debug</Config>
+        <Platform Condition="'$(Platform)'==''">Win32</Platform>
+        <TargetedPlatforms>1</TargetedPlatforms>
+        <AppType>Application</AppType>
+    </PropertyGroup>
+    <PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
+        <Base>true</Base>
+    </PropertyGroup>
+    <PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
+        <Base_Win32>true</Base_Win32>
+        <CfgParent>Base</CfgParent>
+        <Base>true</Base>
+    </PropertyGroup>
+    <PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Base)'=='true') or '$(Base_Win64)'!=''">
+        <Base_Win64>true</Base_Win64>
+        <CfgParent>Base</CfgParent>
+        <Base>true</Base>
+    </PropertyGroup>
+    <PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_1)'!=''">
+        <Cfg_1>true</Cfg_1>
+        <CfgParent>Base</CfgParent>
+        <Base>true</Base>
+    </PropertyGroup>
+    <PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win32)'!=''">
+        <Cfg_1_Win32>true</Cfg_1_Win32>
+        <CfgParent>Cfg_1</CfgParent>
+        <Cfg_1>true</Cfg_1>
+        <Base>true</Base>
+    </PropertyGroup>
+    <PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_2)'!=''">
+        <Cfg_2>true</Cfg_2>
+        <CfgParent>Base</CfgParent>
+        <Base>true</Base>
+    </PropertyGroup>
+    <PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_2)'=='true') or '$(Cfg_2_Win32)'!=''">
+        <Cfg_2_Win32>true</Cfg_2_Win32>
+        <CfgParent>Cfg_2</CfgParent>
+        <Cfg_2>true</Cfg_2>
+        <Base>true</Base>
+    </PropertyGroup>
+    <PropertyGroup Condition="'$(Base)'!=''">
+        <DCC_DcuOutput>.\$(Platform)\$(Config)</DCC_DcuOutput>
+        <DCC_ExeOutput>.\$(Platform)\$(Config)</DCC_ExeOutput>
+        <DCC_E>false</DCC_E>
+        <DCC_N>false</DCC_N>
+        <DCC_S>false</DCC_S>
+        <DCC_F>false</DCC_F>
+        <DCC_K>false</DCC_K>
+        <DCC_UsePackage>RESTComponents;FlexCel_Pdf;emsclientfiredac;DataSnapFireDAC;RemObjects_Server_Indy_D25;FireDACIBDriver;RemObjects_Indy_D25;xdata;emsclient;FireDACCommon;RESTBackendComponents;soapserver;CloudService;FireDACCommonDriver;inet;sparkle;tmsbcl;FireDAC;FlexCel_XlsAdapter;FireDACSqliteDriver;RemObjects_WebBroker_D25;soaprtl;FlexCel_Core;soapmidas;FlexCel_Render;aurelius;$(DCC_UsePackage)</DCC_UsePackage>
+        <DCC_Namespace>System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace)</DCC_Namespace>
+        <Icon_MainIcon>$(BDS)\bin\delphi_PROJECTICON.ico</Icon_MainIcon>
+        <UWP_DelphiLogo44>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png</UWP_DelphiLogo44>
+        <UWP_DelphiLogo150>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png</UWP_DelphiLogo150>
+        <SanitizedProjectName>sqldbrestclient</SanitizedProjectName>
+    </PropertyGroup>
+    <PropertyGroup Condition="'$(Base_Win32)'!=''">
+        <DCC_UsePackage>DBXSqliteDriver;DataSnapServerMidas;DBXDb2Driver;DBXInterBaseDriver;vclactnband;FMX_FlexCel_Core;vclFireDAC;RemObjects_Server_Synapse_D25;FireDACADSDriver;frxe25;DBXMSSQLDriver;vacommpkgdXE11;DatasnapConnectorsFreePascal;FireDACMSSQLDriver;tmsxlsdXE11;vcltouch;VCLTMSFNCCorePkgDXE11;vcldb;bindcompfmx;Intraweb;DBXOracleDriver;fsIBX25;inetdb;CEF4Delphi;TMSCryptoPkgDXE11;tiOPFGUI;FmxTeeUI;emsedge;DataAbstract_DBXDriver_Enterprise_D25;fmx;fmxdae;frxDB25;tmsdXE11;vclib;VCL_FlexCel_Components;frxTee25;tmsexdXE11;FireDACDBXDriver;dbexpress;IndyCore;vclx;dsnap;DataSnapCommon;RemObjects_Synapse_D25;fsTee25;FMXTMSFNCCorePkgDXE11;DataSnapConnectors;VCLRESTComponents;FMXTMSFNCUIPackPkgDXE11;vclie;fs25;bindengine;DBXMySQLDriver;FireDACOracleDriver;FireDACMySQLDriver;DBXFirebirdDriver;TMSWEBCorePkgDXE11;FireDACCommonODBC;DataSnapClient;bindcompdbx;IndyIPCommon;vcl;DBXSybaseASEDriver;IndyIPServer;IndySystem;FireDACDb2Driver;mbColorLibD101Berlin;VCLTMSFNCUIPackPkgDXE11;TMSWEBCorePkgLibDXE11;dsnapcon;madExcept_;FireDACMSAccDriver;fmxFireDAC;FireDACInfxDriver;vclimg;madBasic_;TeeDB;vacommpkgdedXE11;fsADO25;emshosting;FireDACPgDriver;ibmonitor;FireDACASADriver;DBXOdbcDriver;FireDACTDataDriver;FMXTee;DataAbstract_DBXDriver_Pro_D25;frxADO25;DbxCommonDriver;ibxpress;Tee;DataSnapServer;xmlrtl;DataSnapNativeClient;fmxobj;vclwinx;ibxbindings;rtl;FireDACDSDriver;DbxClientDriver;madDisAsm_;DBXSybaseASADriver;tiOPFCore;CustomIPTransport;vcldsnap;CodeSiteExpressPkg;frx25;frxIntIO25;fsDB25;bindcomp;tmswizdXE11;DBXInformixDriver;IndyIPClient;kbmMemRunD102Pro;frxDBX25;bindcompvcl;SynEdit_R;DataAbstract_SQLiteDriver_D25;TeeUI;FMX_FlexCel_Components;dbxcds;VclSmp;VCL_FlexCel_Core;adortl;FireDACODBCDriver;DataAbstract_SpiderMonkeyScripting_D25;DataSnapIndy10ServerTransport;dsnapxml;DataSnapProviderClient;dbrtl;inetdbxpress;FireDACMongoDBDriver;IndyProtocols;frxIBX25;TMSCryptoPkgDEDXE11;fmxase;$(DCC_UsePackage)</DCC_UsePackage>
+        <DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
+        <BT_BuildType>Debug</BT_BuildType>
+        <VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
+        <VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
+        <VerInfo_Locale>1033</VerInfo_Locale>
+        <Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
+    </PropertyGroup>
+    <PropertyGroup Condition="'$(Base_Win64)'!=''">
+        <DCC_UsePackage>DBXSqliteDriver;DataSnapServerMidas;DBXDb2Driver;DBXInterBaseDriver;vclactnband;FMX_FlexCel_Core;vclFireDAC;RemObjects_Server_Synapse_D25;FireDACADSDriver;DBXMSSQLDriver;DatasnapConnectorsFreePascal;FireDACMSSQLDriver;vcltouch;VCLTMSFNCCorePkgDXE11;vcldb;bindcompfmx;Intraweb;DBXOracleDriver;inetdb;TMSCryptoPkgDXE11;FmxTeeUI;emsedge;DataAbstract_DBXDriver_Enterprise_D25;fmx;fmxdae;tmsdXE11;vclib;VCL_FlexCel_Components;tmsexdXE11;FireDACDBXDriver;dbexpress;IndyCore;vclx;dsnap;DataSnapCommon;RemObjects_Synapse_D25;FMXTMSFNCCorePkgDXE11;DataSnapConnectors;VCLRESTComponents;FMXTMSFNCUIPackPkgDXE11;vclie;bindengine;DBXMySQLDriver;FireDACOracleDriver;FireDACMySQLDriver;DBXFirebirdDriver;FireDACCommonODBC;DataSnapClient;bindcompdbx;IndyIPCommon;vcl;DBXSybaseASEDriver;IndyIPServer;IndySystem;FireDACDb2Driver;VCLTMSFNCUIPackPkgDXE11;dsnapcon;FireDACMSAccDriver;fmxFireDAC;FireDACInfxDriver;vclimg;TeeDB;emshosting;FireDACPgDriver;ibmonitor;FireDACASADriver;DBXOdbcDriver;FireDACTDataDriver;FMXTee;DataAbstract_DBXDriver_Pro_D25;DbxCommonDriver;ibxpress;Tee;DataSnapServer;xmlrtl;DataSnapNativeClient;fmxobj;vclwinx;ibxbindings;rtl;FireDACDSDriver;DbxClientDriver;DBXSybaseASADriver;CustomIPTransport;vcldsnap;bindcomp;DBXInformixDriver;IndyIPClient;bindcompvcl;SynEdit_R;DataAbstract_SQLiteDriver_D25;TeeUI;FMX_FlexCel_Components;dbxcds;VclSmp;VCL_FlexCel_Core;adortl;FireDACODBCDriver;DataAbstract_SpiderMonkeyScripting_D25;DataSnapIndy10ServerTransport;dsnapxml;DataSnapProviderClient;dbrtl;inetdbxpress;FireDACMongoDBDriver;IndyProtocols;fmxase;$(DCC_UsePackage)</DCC_UsePackage>
+    </PropertyGroup>
+    <PropertyGroup Condition="'$(Cfg_1)'!=''">
+        <DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
+        <DCC_DebugDCUs>true</DCC_DebugDCUs>
+        <DCC_Optimize>false</DCC_Optimize>
+        <DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
+        <DCC_DebugInfoInExe>true</DCC_DebugInfoInExe>
+        <DCC_RemoteDebug>true</DCC_RemoteDebug>
+    </PropertyGroup>
+    <PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
+        <DCC_RemoteDebug>false</DCC_RemoteDebug>
+        <AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
+        <AppEnableHighDPI>true</AppEnableHighDPI>
+    </PropertyGroup>
+    <PropertyGroup Condition="'$(Cfg_2)'!=''">
+        <DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
+        <DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
+        <DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
+        <DCC_DebugInformation>0</DCC_DebugInformation>
+    </PropertyGroup>
+    <PropertyGroup Condition="'$(Cfg_2_Win32)'!=''">
+        <AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
+        <AppEnableHighDPI>true</AppEnableHighDPI>
+    </PropertyGroup>
+    <ItemGroup>
+        <DelphiCompile Include="$(MainSource)">
+            <MainSource>MainSource</MainSource>
+        </DelphiCompile>
+        <DCCReference Include="frmmain.pas">
+            <Form>Form1</Form>
+            <FormType>dfm</FormType>
+        </DCCReference>
+        <BuildConfiguration Include="Release">
+            <Key>Cfg_2</Key>
+            <CfgParent>Base</CfgParent>
+        </BuildConfiguration>
+        <BuildConfiguration Include="Base">
+            <Key>Base</Key>
+        </BuildConfiguration>
+        <BuildConfiguration Include="Debug">
+            <Key>Cfg_1</Key>
+            <CfgParent>Base</CfgParent>
+        </BuildConfiguration>
+    </ItemGroup>
+    <ProjectExtensions>
+        <Borland.Personality>Delphi.Personality.12</Borland.Personality>
+        <Borland.ProjectType>Application</Borland.ProjectType>
+        <BorlandProject>
+            <Delphi.Personality>
+                <Source>
+                    <Source Name="MainSource">sqldbrestclient.dpr</Source>
+                </Source>
+            </Delphi.Personality>
+            <Deployment Version="3">
+                <DeployFile LocalName="Win32\Debug\sqldbrestclient.exe" Configuration="Debug" Class="ProjectOutput">
+                    <Platform Name="Win32">
+                        <RemoteName>sqldbrestclient.exe</RemoteName>
+                        <Overwrite>true</Overwrite>
+                    </Platform>
+                </DeployFile>
+                <DeployClass Name="AdditionalDebugSymbols">
+                    <Platform Name="iOSSimulator">
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="OSX32">
+                        <RemoteDir>Contents\MacOS</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="Win32">
+                        <RemoteDir>Contents\MacOS</RemoteDir>
+                        <Operation>0</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="AndroidClassesDexFile">
+                    <Platform Name="Android">
+                        <RemoteDir>classes</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="AndroidGDBServer">
+                    <Platform Name="Android">
+                        <RemoteDir>library\lib\armeabi-v7a</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="AndroidLibnativeArmeabiFile">
+                    <Platform Name="Android">
+                        <RemoteDir>library\lib\armeabi</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="AndroidLibnativeMipsFile">
+                    <Platform Name="Android">
+                        <RemoteDir>library\lib\mips</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="AndroidServiceOutput">
+                    <Platform Name="Android">
+                        <RemoteDir>library\lib\armeabi-v7a</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="AndroidSplashImageDef">
+                    <Platform Name="Android">
+                        <RemoteDir>res\drawable</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="AndroidSplashStyles">
+                    <Platform Name="Android">
+                        <RemoteDir>res\values</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="Android_DefaultAppIcon">
+                    <Platform Name="Android">
+                        <RemoteDir>res\drawable</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="Android_LauncherIcon144">
+                    <Platform Name="Android">
+                        <RemoteDir>res\drawable-xxhdpi</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="Android_LauncherIcon36">
+                    <Platform Name="Android">
+                        <RemoteDir>res\drawable-ldpi</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="Android_LauncherIcon48">
+                    <Platform Name="Android">
+                        <RemoteDir>res\drawable-mdpi</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="Android_LauncherIcon72">
+                    <Platform Name="Android">
+                        <RemoteDir>res\drawable-hdpi</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="Android_LauncherIcon96">
+                    <Platform Name="Android">
+                        <RemoteDir>res\drawable-xhdpi</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="Android_SplashImage426">
+                    <Platform Name="Android">
+                        <RemoteDir>res\drawable-small</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="Android_SplashImage470">
+                    <Platform Name="Android">
+                        <RemoteDir>res\drawable-normal</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="Android_SplashImage640">
+                    <Platform Name="Android">
+                        <RemoteDir>res\drawable-large</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="Android_SplashImage960">
+                    <Platform Name="Android">
+                        <RemoteDir>res\drawable-xlarge</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="DebugSymbols">
+                    <Platform Name="iOSSimulator">
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="OSX32">
+                        <RemoteDir>Contents\MacOS</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="Win32">
+                        <Operation>0</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="DependencyFramework">
+                    <Platform Name="OSX32">
+                        <RemoteDir>Contents\MacOS</RemoteDir>
+                        <Operation>1</Operation>
+                        <Extensions>.framework</Extensions>
+                    </Platform>
+                    <Platform Name="Win32">
+                        <Operation>0</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="DependencyModule">
+                    <Platform Name="iOSDevice32">
+                        <Operation>1</Operation>
+                        <Extensions>.dylib</Extensions>
+                    </Platform>
+                    <Platform Name="iOSDevice64">
+                        <Operation>1</Operation>
+                        <Extensions>.dylib</Extensions>
+                    </Platform>
+                    <Platform Name="iOSSimulator">
+                        <Operation>1</Operation>
+                        <Extensions>.dylib</Extensions>
+                    </Platform>
+                    <Platform Name="OSX32">
+                        <RemoteDir>Contents\MacOS</RemoteDir>
+                        <Operation>1</Operation>
+                        <Extensions>.dylib</Extensions>
+                    </Platform>
+                    <Platform Name="Win32">
+                        <Operation>0</Operation>
+                        <Extensions>.dll;.bpl</Extensions>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Required="true" Name="DependencyPackage">
+                    <Platform Name="iOSDevice32">
+                        <Operation>1</Operation>
+                        <Extensions>.dylib</Extensions>
+                    </Platform>
+                    <Platform Name="iOSDevice64">
+                        <Operation>1</Operation>
+                        <Extensions>.dylib</Extensions>
+                    </Platform>
+                    <Platform Name="iOSSimulator">
+                        <Operation>1</Operation>
+                        <Extensions>.dylib</Extensions>
+                    </Platform>
+                    <Platform Name="OSX32">
+                        <RemoteDir>Contents\MacOS</RemoteDir>
+                        <Operation>1</Operation>
+                        <Extensions>.dylib</Extensions>
+                    </Platform>
+                    <Platform Name="Win32">
+                        <Operation>0</Operation>
+                        <Extensions>.bpl</Extensions>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="File">
+                    <Platform Name="Android">
+                        <Operation>0</Operation>
+                    </Platform>
+                    <Platform Name="iOSDevice32">
+                        <Operation>0</Operation>
+                    </Platform>
+                    <Platform Name="iOSDevice64">
+                        <Operation>0</Operation>
+                    </Platform>
+                    <Platform Name="iOSSimulator">
+                        <Operation>0</Operation>
+                    </Platform>
+                    <Platform Name="OSX32">
+                        <RemoteDir>Contents\Resources\StartUp\</RemoteDir>
+                        <Operation>0</Operation>
+                    </Platform>
+                    <Platform Name="Win32">
+                        <Operation>0</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="iPad_Launch1024">
+                    <Platform Name="iOSDevice32">
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="iOSDevice64">
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="iOSSimulator">
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="iPad_Launch1536">
+                    <Platform Name="iOSDevice32">
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="iOSDevice64">
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="iOSSimulator">
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="iPad_Launch2048">
+                    <Platform Name="iOSDevice32">
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="iOSDevice64">
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="iOSSimulator">
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="iPad_Launch768">
+                    <Platform Name="iOSDevice32">
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="iOSDevice64">
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="iOSSimulator">
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="iPhone_Launch320">
+                    <Platform Name="iOSDevice32">
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="iOSDevice64">
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="iOSSimulator">
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="iPhone_Launch640">
+                    <Platform Name="iOSDevice32">
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="iOSDevice64">
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="iOSSimulator">
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="iPhone_Launch640x1136">
+                    <Platform Name="iOSDevice32">
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="iOSDevice64">
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="iOSSimulator">
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="ProjectAndroidManifest">
+                    <Platform Name="Android">
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="ProjectiOSDeviceDebug">
+                    <Platform Name="iOSDevice32">
+                        <RemoteDir>..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="iOSDevice64">
+                        <RemoteDir>..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="ProjectiOSDeviceResourceRules">
+                    <Platform Name="iOSDevice32">
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="iOSDevice64">
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="ProjectiOSEntitlements">
+                    <Platform Name="iOSDevice32">
+                        <RemoteDir>..\</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="iOSDevice64">
+                        <RemoteDir>..\</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="ProjectiOSInfoPList">
+                    <Platform Name="iOSDevice32">
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="iOSDevice64">
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="iOSSimulator">
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="ProjectiOSResource">
+                    <Platform Name="iOSDevice32">
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="iOSDevice64">
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="iOSSimulator">
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="ProjectOSXEntitlements">
+                    <Platform Name="OSX32">
+                        <RemoteDir>..\</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="ProjectOSXInfoPList">
+                    <Platform Name="OSX32">
+                        <RemoteDir>Contents</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="ProjectOSXResource">
+                    <Platform Name="OSX32">
+                        <RemoteDir>Contents\Resources</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Required="true" Name="ProjectOutput">
+                    <Platform Name="Android">
+                        <RemoteDir>library\lib\armeabi-v7a</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="iOSDevice32">
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="iOSDevice64">
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="iOSSimulator">
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="Linux64">
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="OSX32">
+                        <RemoteDir>Contents\MacOS</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="Win32">
+                        <Operation>0</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="ProjectUWPManifest">
+                    <Platform Name="Win32">
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="Win64">
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="UWP_DelphiLogo150">
+                    <Platform Name="Win32">
+                        <RemoteDir>Assets</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="Win64">
+                        <RemoteDir>Assets</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="UWP_DelphiLogo44">
+                    <Platform Name="Win32">
+                        <RemoteDir>Assets</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="Win64">
+                        <RemoteDir>Assets</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <ProjectRoot Platform="iOSDevice64" Name="$(PROJECTNAME).app"/>
+                <ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/>
+                <ProjectRoot Platform="iOSDevice32" Name="$(PROJECTNAME).app"/>
+                <ProjectRoot Platform="Linux64" Name="$(PROJECTNAME)"/>
+                <ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/>
+                <ProjectRoot Platform="OSX32" Name="$(PROJECTNAME).app"/>
+                <ProjectRoot Platform="Android" Name="$(PROJECTNAME)"/>
+                <ProjectRoot Platform="iOSSimulator" Name="$(PROJECTNAME).app"/>
+            </Deployment>
+            <Platforms>
+                <Platform value="Win32">True</Platform>
+                <Platform value="Win64">False</Platform>
+            </Platforms>
+        </BorlandProject>
+        <ProjectFileVersion>12</ProjectFileVersion>
+    </ProjectExtensions>
+    <Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/>
+    <Import Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj" Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')"/>
+    <Import Project="$(MSBuildProjectName).deployproj" Condition="Exists('$(MSBuildProjectName).deployproj')"/>
+</Project>

packages/fcl-web/examples/restbridge/demorestbridge.lpi

@@ -0,0 +1,62 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="11"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="SQLDB REST bridge Application"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+      <Modes Count="0"/>
+    </RunParams>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="demorestbridge.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="demorestbridge"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Linking>
+      <Debugging>
+        <UseHeaptrc Value="True"/>
+      </Debugging>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

packages/fcl-web/examples/restbridge/demorestbridge.pp

@@ -0,0 +1,160 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2019 by the Free Pascal development team
+
+    SQLDB REST rest bridge demo applocation.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+program demorestbridge;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Classes, SysUtils, CustApp, sqldbrestbridge, fphttpapp, IBConnection, odbcconn, mysql55conn, mysql56conn, pqconnection,
+  mssqlconn, oracleconnection, sqldbrestxml, sqldbrestio, sqldbrestschema, sqldbrestdata, sqldbrestjson, sqldbrestcsv, sqldbrestcds,
+  sqldbrestconst, sqldbrestauth, sqldbrestini, sqldb, sqldbrestauthini
+  ;
+
+type
+  { TXMLSQLDBRestDispatcher }
+
+  TXMLSQLDBRestDispatcher = class(TSQLDBRestDispatcher)
+    Function CreateOutputStreamer(IO: TRestIO): TRestOutputStreamer; override;
+  end;
+
+  { TRestServerDemoApplication }
+
+  TRestServerDemoApplication = class(THTTPApplication)
+  private
+    procedure DoAfterRequest(Sender: TObject; aConn: TSQLConnection; aResource: TSQLDBRestResource);
+  Protected
+    FAuth : TRestBasicAuthenticator;
+    FDisp : TSQLDBRestDispatcher;
+    FRequestCount,
+    FMaxRequests : integer;
+  protected
+    procedure DoRun; override;
+  public
+    constructor Create(TheOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure WriteHelp; virtual;
+  end;
+
+{ TXMLSQLDBRestDispatcher }
+
+function TXMLSQLDBRestDispatcher.CreateOutputStreamer(IO: TRestIO): TRestOutputStreamer;
+begin
+  io.Response.ContentStream:=TMemoryStream.Create;
+  io.Response.FreeContentStream:=True;
+  Result:=TXMLOutputStreamer.Create(IO.Response.ContentStream,Strings,@IO.DoGetVariable);
+end;
+
+{ TRestServerDemoApplication }
+
+procedure TRestServerDemoApplication.DoAfterRequest(Sender: TObject; aConn: TSQLConnection; aResource: TSQLDBRestResource);
+begin
+  inc(FRequestCount);
+  if (FMaxRequests>0) and (FRequestCount>=FMaxRequests) then
+    begin
+    DoLog(etInfo,'Maximum requests reached');
+    Terminate;
+    end;
+end;
+
+procedure TRestServerDemoApplication.DoRun;
+var
+  ErrorMsg: String;
+begin
+  // quick check parameters
+  ErrorMsg:=CheckOptions('hc:s:m:', ['help','config:','save-config:','max-requests:']);
+  if ErrorMsg<>'' then begin
+    ShowException(Exception.Create(ErrorMsg));
+    Terminate;
+    Exit;
+  end;
+
+  // parse parameters
+  if HasOption('h', 'help') then begin
+    WriteHelp;
+    Terminate;
+    Exit;
+  end;
+  Port:=3000;
+  FDisp:=TSQLDBRestDispatcher.Create(Self);
+  if HasOption('c', 'config') then
+    FDisp.LoadFromFile(GetOptionValue('c', 'config'),[dioSkipReadSchemas])
+  else
+    begin
+    // create a Default setup
+    FAuth:=TRestBasicAuthenticator.Create(Self);
+    FAuth.DefaultUserName:='me';
+    FAuth.DefaultPassword:='secret';
+    FAuth.AuthenticateUserSQL.Text:='select uID from users where (uLogin=:UserName) and (uPassword=:Password)';
+    FDisp.DispatchOptions:=FDisp.DispatchOptions+[rdoConnectionInURL,rdoCustomView,rdoHandleCORS];
+    FDisp.ExposeDatabase(TPQConnectionDef.TypeName,'localhost','expensetracker','me','secret',Nil,[foFilter,foInInsert,foInUpdate,foOrderByDesc]);
+    With FDisp.Schemas[0].Schema.Resources do
+      begin
+      FindResourceByName('users').Fields.FindByFieldName('uID').GeneratorName:='seqUsersID';
+      FindResourceByName('projects').Fields.FindByFieldName('pID').GeneratorName:='seqProjectsID';
+      FindResourceByName('expensetypes').Fields.FindByFieldName('etID').GeneratorName:='seqExpenseTypesID';
+      FindResourceByName('expenses').Fields.FindByFieldName('eID').GeneratorName:='seqExpenseID';
+      end;
+    FDisp.Authenticator:=Fauth;
+    if HasOption('s','save-config') then
+      FDisp.SaveToFile(GetOptionValue('s','save-config'));
+    end;
+  // Mostly for debug purposes, to get e.g. a heap trace
+  if HasOption('m','max-requests') then
+    FMaxRequests:=StrToIntDef(GetOptionValue('m','max-requests'),0);
+  FDisp.AfterGet:=@DoAfterRequest;
+  FDisp.AfterPost:=@DoAfterRequest;
+  FDisp.AfterPut:=@DoAfterRequest;
+  FDisp.AfterDelete:=@DoAfterRequest;
+  FDisp.Active:=True;
+  Inherited DoRun;
+end;
+
+constructor TRestServerDemoApplication.Create(TheOwner: TComponent);
+begin
+  inherited Create(TheOwner);
+  StopOnException:=True;
+end;
+
+destructor TRestServerDemoApplication.Destroy;
+begin
+  FreeAndNil(FDisp);
+  FreeAndNil(FAuth);
+  inherited Destroy;
+end;
+
+procedure TRestServerDemoApplication.WriteHelp;
+begin
+  writeln('Usage: ', ExeName, ' [options]');
+  Writeln('Where options is one or more of:');
+  Writeln('-h --help             this message');
+  Writeln('-c --config=File      Read config from .ini file');
+  Writeln('-m --max-requests=N   Server at most N requests, then quit.');
+  Writeln('-s --saveconfig=File  Write config to .ini file (ignored when -c or --config is used)');
+end;
+
+var
+  Application: TRestServerDemoApplication;
+
+begin
+  Application:=TRestServerDemoApplication.Create(nil);
+  Application.Title:='SQLDB REST bridge Application';
+  Application.Run;
+  Application.Free;
+end.
+

packages/fcl-web/examples/restbridge/expenses-data.sql

@@ -0,0 +1,10 @@
+insert into users (uLogin,uFullName,uPassword) values ('Michael','Michaël Van Canneyt','secret');
+insert into users (uLogin,uFullName,uPassword) values ('Mattias','Mattias Gaertner','secret');
+insert into users (uLogin,uFullName,uPassword) values ('Detlef','Detlef overbeek','secret');
+insert into projects (pName,pDescription) values ('Pas2JS','Pas2JS - Pascal to Javascript converter');
+insert into projects (pName,pDescription) values ('FPC','FPC - Open source pascal compiler');
+insert into projects (pName,pDescription) values ('Lazarus','Lazarus - Open source IDE for Pascal');
+insert into projects (pName,pDescription) values ('JSONViewer','Lazarus JSON viewer tool');
+insert into ExpenseTypes (etName,etDescription) values ('Transport','Travel by bus/train/airplane');
+insert into ExpenseTypes (etName,etDescription) values ('Car','Travel by car');
+insert into ExpenseTypes (etName,etDescription) values ('Food','expenses in Bar, Restaurant');

packages/fcl-web/examples/restbridge/expenses-pq.sql

@@ -0,0 +1,45 @@
+drop table ExpenseTypes;
+create table ExpenseTypes (
+  etID bigint not null default nextval('seqExpenseTypesID'),
+  etName varchar(50) not null,
+  etDescription varchar(100) not null,
+  etMaxAmount decimal(10,2),
+  etCost decimal(10,2) default 1,
+  etActive boolean not null default true
+);
+
+create sequence seqUsersID;
+create table Users (
+  uID bigint not null default nextval('seqUsersID'),
+  uLogin varchar(50) not null,
+  uFullName varchar(100) not null,
+  uPassword varchar(100) not null,
+  uActive boolean not null default true 
+);
+
+create sequence seqProjectsID;
+create table Projects (
+  pID bigint not null default nextval('seqProjectsID'),
+  pName varchar(50) not null,
+  pDescription varchar(100) not null,
+  pActive boolean not null default true
+);
+
+create sequence seqExpenseTypesID;
+
+create sequence seqExpenseID;
+drop table Expenses;
+create table Expenses (
+  eID bigint not null default nextval('seqExpenseID'),
+  eUserFK bigint not null,
+  eProjectFK bigint not null,
+  eTypeFK bigint not null,
+  eAmount decimal(10,2) not null,
+  eDate date not null default 'today',
+  eComment varchar(1024)
+);
+
+alter table ExpenseTypes add constraint pkExpenseTypes primary key (etID);
+alter table Users add constraint pkUsers primary key (uID);
+alter table Projects add constraint pkProjects primary key (pID);
+alter table Expenses add  constraint pkExpenses primary key (eID);

packages/fcl-web/fpmake.pp

@@ -48,6 +48,7 @@ begin
     P.SourcePath.Add('src/webdata');
     P.SourcePath.Add('src/jsonrpc');
     P.SourcePath.Add('src/hpack');
+    P.SourcePath.Add('src/restbridge');
 
     T:=P.Targets.AddUnit('httpdefs.pp');
     T.ResourceStrings:=true;
@@ -294,6 +295,85 @@ begin
       AddUnit('uhpackimp');
       end;
     
+    T:=P.Targets.AddUnit('sqldbrestconst.pp');
+    T.ResourceStrings:=true;
+    
+    T:=P.Targets.AddUnit('sqldbrestschema.pp');
+    With T.Dependencies do  
+      begin
+      AddUnit('sqldbrestconst');
+      end;
+    T:=P.Targets.AddUnit('sqldbrestio.pp');
+    With T.Dependencies do  
+      begin
+      AddUnit('sqldbrestconst');
+      AddUnit('sqldbrestschema');
+      end;
+    T:=P.Targets.AddUnit('sqldbrestdata.pp');
+    With T.Dependencies do  
+      begin
+      AddUnit('sqldbrestconst');
+      AddUnit('sqldbrestschema');
+      AddUnit('sqldbrestio');
+      end;
+    T:=P.Targets.AddUnit('sqldbrestauth.pp');
+    With T.Dependencies do  
+      begin
+      AddUnit('sqldbrestconst');
+      AddUnit('sqldbrestio');
+      AddUnit('sqldbrestschema');
+      end;
+    T:=P.Targets.AddUnit('sqldbrestjson.pp');
+    With T.Dependencies do  
+      begin
+      AddUnit('sqldbrestio');
+      AddUnit('sqldbrestschema');
+      AddUnit('sqldbrestconst');
+      end;
+    T:=P.Targets.AddUnit('sqldbrestbridge.pp');
+    With T.Dependencies do  
+      begin
+      AddUnit('sqldbrestio');
+      AddUnit('sqldbrestdata');
+      AddUnit('sqldbrestschema');
+      AddUnit('sqldbrestconst');
+      end;
+    T:=P.Targets.AddUnit('sqldbrestcds.pp');
+    With T.Dependencies do  
+      begin
+      AddUnit('sqldbrestio');
+      AddUnit('sqldbrestschema');
+      AddUnit('sqldbrestconst');
+      end;
+    T:=P.Targets.AddUnit('sqldbrestcsv.pp');
+    With T.Dependencies do  
+      begin
+      AddUnit('sqldbrestio');
+      AddUnit('sqldbrestschema');
+      AddUnit('sqldbrestconst');
+      end;
+    T:=P.Targets.AddUnit('sqldbrestxml.pp');
+    With T.Dependencies do  
+      begin
+      AddUnit('sqldbrestio');
+      AddUnit('sqldbrestschema');
+      AddUnit('sqldbrestconst');
+      end;
+    T:=P.Targets.AddUnit('sqldbrestini.pp');
+    With T.Dependencies do  
+      begin
+      AddUnit('sqldbrestbridge');
+      AddUnit('sqldbrestschema');
+      AddUnit('sqldbrestconst');
+      end;
+    T:=P.Targets.AddUnit('sqldbrestauthini.pp');
+    With T.Dependencies do  
+      begin
+      AddUnit('sqldbrestauth');
+      AddUnit('sqldbrestschema');
+      AddUnit('sqldbrestconst');
+      end;
+    
 {$ifndef ALLPACKAGES}
     Run;
     end;

packages/fcl-web/src/base/custweb.pp

@@ -733,6 +733,7 @@ begin
   FWebHandler.Free;
   if assigned(FEventLog) then
     FEventLog.Free;
+  Inherited;
 end;
 
 procedure TCustomWebApplication.CreateForm(AClass: TComponentClass; out Reference);

packages/fcl-web/src/restbridge/sqldbrestauth.pp

@@ -0,0 +1,263 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2019 by the Free Pascal development team
+
+    SQLDB REST HTTP BASIC authentication.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit sqldbrestauth;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, sqldb, db, sqldbrestconst, sqldbrestio, httpdefs;
+
+Type
+  TAuthenticateEvent = procedure (Sender : TObject; aRequest : TRequest) of object;
+
+  { TRestAuthenticator }
+
+  TRestAuthenticator = Class(TComponent)
+  private
+    FAfterAuthenticate: TAuthenticateEvent;
+    FBeforeAuthenticate: TAuthenticateEvent;
+  Protected
+    function DoAuthenticateRequest(io : TRestIO) : Boolean; virtual; abstract;
+  Public
+    Function AuthenticateRequest(io : TRestIO) : Boolean;
+    Function NeedConnection : Boolean; virtual;
+  Published
+    Property BeforeAuthenticate : TAuthenticateEvent Read FBeforeAuthenticate Write FBeforeAuthenticate;
+    Property AfterAuthenticate : TAuthenticateEvent Read FAfterAuthenticate Write FAfterAuthenticate;
+  end;
+
+  TBasicAuthenticationEvent = procedure (sender : TObject; Const aUserName,aPassword : UTF8String; Var allow : Boolean; Var UserID : UTF8String) of object;
+
+  { TRestBasicAuthenticator }
+
+  TRestBasicAuthenticator = Class(TRestAuthenticator)
+  private
+    FAuthConnection: TSQLConnection;
+    FAuthenticationRealm: UTF8String;
+    FAuthSQL: TStringList;
+    FDefaultPassword: UTF8String;
+    FDefaultUserID: UTF8String;
+    FDefaultUserName: UTF8String;
+    FOnBasicAuthentication: TBasicAuthenticationEvent;
+    function GetAuthenticationRealm: UTF8String;
+    function GetAuthSQL: TStrings;
+    function IsNotDefaultRealm: Boolean;
+    procedure SetAuthConnection(AValue: TSQLConnection);
+    procedure SetAuthSQL(AValue: TStrings);
+  Protected
+    function HaveAuthSQL: Boolean;
+    function AuthenticateUserUsingSQl(IO: TRestIO; const UN, PW: UTF8String; out UID: UTF8String): Boolean; virtual;
+  Public
+    Constructor Create(AOwner :TComponent); override;
+    Destructor Destroy; override;
+    class function ExtractUserNamePassword(Req: TRequest; out UN, PW: UTF8String): Boolean;
+    Function NeedConnection : Boolean; override;
+    function DoAuthenticateRequest(IO : TRestIO) : Boolean; override;
+  Published
+    Property AuthConnection : TSQLConnection Read FAuthConnection Write SetAuthConnection;
+    Property AuthenticateUserSQL : TStrings Read GetAuthSQL Write SetAuthSQL;
+    Property DefaultUserName : UTF8String Read FDefaultUserName Write FDefaultUserName;
+    Property DefaultPassword : UTF8String Read FDefaultPassword Write FDefaultPassword;
+    Property DefaultUserID : UTF8String Read FDefaultUserID Write FDefaultUserID ;
+    Property AuthenticationRealm : UTF8String Read GetAuthenticationRealm Write FAuthenticationRealm Stored IsNotDefaultRealm;
+    Property OnBasicAuthentication : TBasicAuthenticationEvent Read FOnBasicAuthentication Write FOnBasicAuthentication;
+  end;
+
+implementation
+
+uses strutils, base64;
+
+{ TRestBasicAuthenticator }
+
+function TRestBasicAuthenticator.GetAuthenticationRealm: UTF8String;
+begin
+  Result:=FAuthenticationRealm;
+  if Result='' then
+    Result:=DefaultAuthenticationRealm;
+end;
+
+function TRestBasicAuthenticator.GetAuthSQL: TStrings;
+begin
+  Result:=FAuthSQL;
+end;
+
+function TRestBasicAuthenticator.IsNotDefaultRealm: Boolean;
+begin
+  Result:=(GetAuthenticationRealm<>DefaultAuthenticationRealm);
+end;
+
+procedure TRestBasicAuthenticator.SetAuthConnection(AValue: TSQLConnection);
+begin
+  if FAuthConnection=AValue then Exit;
+  If Assigned(FAuthConnection) then
+    FAuthConnection.RemoveFreeNotification(Self);
+  FAuthConnection:=AValue;
+  If Assigned(FAuthConnection) then
+    FAuthConnection.FreeNotification(Self);
+end;
+
+procedure TRestBasicAuthenticator.SetAuthSQL(AValue: TStrings);
+begin
+  if FAuthSQL=AValue then Exit;
+  FAuthSQL.Assign(AValue);
+end;
+
+constructor TRestBasicAuthenticator.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FAuthSQL:=TStringList.Create;
+end;
+
+destructor TRestBasicAuthenticator.Destroy;
+begin
+  FreeAndNil(FAuthSQL);
+  inherited Destroy;
+end;
+
+function TRestBasicAuthenticator.NeedConnection: Boolean;
+begin
+  Result:=HaveAuthSQL and (AuthConnection=Nil);
+end;
+
+Function TRestBasicAuthenticator.HaveAuthSQL : Boolean;
+
+begin
+  Result:=(FAuthSQL.Count>0) and (Trim(FAuthSQL.Text)<>'');
+end;
+
+function TRestBasicAuthenticator.AuthenticateUserUsingSQl(IO : TRestIO; Const UN,PW : UTF8String; Out UID : UTF8String) : Boolean;
+
+Var
+  Conn : TSQLConnection;
+  Q : TSQLQuery;
+  P : TParam;
+
+begin
+  Result:=HaveAuthSQL;
+  if not Result then
+     exit;
+  Conn:=Self.AuthConnection;
+  if Conn=Nil then
+    Conn:=IO.Connection;
+  Result:=Conn<>Nil;
+  if not Result then
+    exit;
+  Q:=TSQLQuery.Create(Self);
+  try
+    Q.Database:=Conn;
+    if IO.Transaction<>nil then
+      Q.Transaction:=IO.Transaction;
+    Q.SQL:=FAuthSQL;
+    P:=Q.Params.FindParam('UserName');
+    if P<>Nil then
+      P.AsString:=UN;
+    P:=Q.Params.FindParam('Password');
+    if P<>Nil then
+      P.AsString:=PW;
+    Q.UniDirectional:=True;
+    Q.UsePrimaryKeyAsKey:=False;
+    Q.Open;
+    Result:=Not (Q.EOF and Q.BOF);
+    If Result then
+      UID:=Q.Fields[0].AsString;
+  finally
+    Q.Free;
+  end;
+end;
+
+Class Function TRestBasicAuthenticator.ExtractUserNamePassword(Req : TRequest; Out UN,PW : UTF8String) : Boolean;
+
+Var
+  S,A : String;
+
+begin
+  S:=Req.Authorization;
+  Result:=(S<>'');
+  if not Result then
+    begin
+    UN:='';
+    PW:='';
+    end
+  else
+    begin
+    A:=ExtractWord(1,S,[' ']);
+    S:=ExtractWord(2,S,[' ']);
+    if Not SameText(A,'BASIC') then
+      Exit(False);
+    S:=DecodeStringBase64(S);
+    UN:=ExtractWord(1,S,[':']);
+    PW:=ExtractWord(2,S,[':']);
+    end;
+end;
+
+function TRestBasicAuthenticator.DoAuthenticateRequest(io: TRestIO): Boolean;
+
+Var
+  UID,UN,PW : UTF8String;
+
+begin
+  Result:=False;
+  UID:='';
+  if ExtractUserNamePassword(IO.Request,UN,PW) then
+    begin
+    if (UN<>'') and (PW<>'') then
+      If (DefaultUserName<>'') and (DefaultPassword<>'') then
+        begin
+        Result:=(UN=DefaultUserName) and (PW=DefaultPassword);
+        If Result then
+          begin
+          UID:=DefaultUserID;
+          If UID='' then
+            UID:=DefaultUserName;
+          end;
+        end
+      else
+        UID:=UN;
+    if Assigned(FOnBasicAuthentication) then
+       FOnBasicAuthentication(Self,UN,PW,Result,UID);
+    if not Result then
+      Result:=AuthenticateUserUsingSQl(IO,UN,PW,UID);
+    end;
+  If Result then
+    IO.UserID:=UID
+  else
+    begin
+    IO.Response.Code:=401;
+    IO.Response.CodeText:=SUnauthorized;
+    IO.Response.WWWAuthenticate:=Format('BASIC Realm: "%s"',[AuthenticationRealm]);
+    end;
+end;
+
+{ TRestAuthenticator }
+
+function TRestAuthenticator.AuthenticateRequest(io: TRestIO): Boolean;
+begin
+  If Assigned(FBeforeAuthenticate) then
+    FBeforeAuthenticate(self,IO.Request);
+  Result:=DoAuthenticateRequest(IO);
+  If Assigned(FAfterAuthenticate) then
+    FAfterAuthenticate(self,IO.Request);
+end;
+
+function TRestAuthenticator.NeedConnection: Boolean;
+begin
+  Result:=False;
+end;
+
+
+end.
+

packages/fcl-web/src/restbridge/sqldbrestauthini.pp

@@ -0,0 +1,211 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2019 by the Free Pascal development team
+
+    SQLDB REST bridge : HTTP authorization
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit sqldbrestauthini;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, sqldbrestauth, inifiles;
+
+Type
+  TBasicAuthIniOption = (baoClearOnRead,      // Clear values first
+                         baoSkipPassword,     // Do not save/load password
+                         baoSkipMaskPassword, // do not mask the password
+                         baoUserNameAsMask    // use the username as mask for password
+                         );
+  TBasicAuthIniOptions = Set of TBasicAuthIniOption;
+
+  TSQLDBRestBasicAuthHelper = class helper for TRestBasicAuthenticator
+  Private
+    Procedure ClearValues;
+  Public
+    Procedure LoadFromIni(Const aIni: TCustomIniFile; aOptions : TBasicAuthIniOptions = []); overload;
+    Procedure LoadFromIni(Const aIni: TCustomIniFile; ASection : String; aOptions : TBasicAuthIniOptions); overload;
+    Procedure LoadFromFile(Const aFileName : String; aOptions : TBasicAuthIniOptions = []); overload;
+    Procedure LoadFromFile(Const aFileName : String; Const ASection : String; aOptions : TBasicAuthIniOptions); overload;
+    Procedure SaveToFile(Const aFileName : String; aOptions : TBasicAuthIniOptions = []);overload;
+    Procedure SaveToFile(Const aFileName : String; Const ASection : String; aOptions : TBasicAuthIniOptions = []);overload;
+    Procedure SaveToIni(Const aIni: TCustomIniFile; aOptions : TBasicAuthIniOptions = []); overload;
+    Procedure SaveToIni(Const aIni: TCustomIniFile; ASection : String; aOptions : TBasicAuthIniOptions); overload;
+  end;
+
+Var
+  DefaultBasicAuthSection : String = 'BasicAuth';
+  TrivialEncryptKey : String = 'SQLDBAuth';
+
+Function BasicAuthIniOptionsToStr(Options: TBasicAuthIniOptions): String;
+Function StrToBasicAuthIniOptions(S : String) : TBasicAuthIniOptions;
+
+implementation
+
+uses typinfo,strutils;
+
+Function BasicAuthIniOptionsToStr(Options: TBasicAuthIniOptions): String;
+
+begin
+  Result:=SetToString(PTypeInfo(TypeInfo(TBasicAuthIniOptions)),Integer(Options),false);
+end;
+
+Function StrToBasicAuthIniOptions(S : String) : TBasicAuthIniOptions;
+
+var
+  i : integer;
+begin
+  I:=StringToSet(PTypeInfo(TypeInfo(TBasicAuthIniOptions)),S);
+  Result:=TBasicAuthIniOptions(I);
+end;
+
+
+{ TSQLDBRestBasicAuthHelper }
+
+Const
+  KeyUserID = 'UserID';
+  KeyUserName = 'UserName';
+  KeyPassword = 'Password';
+  KeyRealm = 'Realm';
+  KeySQL = 'SQL';
+
+
+
+procedure TSQLDBRestBasicAuthHelper.ClearValues;
+begin
+  DefaultUserID:='';
+  DefaultUserName:='';
+  DefaultPassword:='';
+  AuthenticateUserSQL.Clear;
+  AuthenticationRealm:='';
+end;
+
+procedure TSQLDBRestBasicAuthHelper.LoadFromIni(const aIni: TCustomIniFile; ASection: String; aOptions: TBasicAuthIniOptions);
+
+Var
+  M,P : String;
+begin
+  With aIni do
+    begin
+    if (baoClearOnRead in aOptions) then
+       ClearValues;
+    DefaultUserName:=ReadString(ASection,KeyUserName,DefaultUserName);
+    DefaultUserID:=ReadString(ASection,KeyUserID,DefaultUserID);
+    AuthenticationRealm:=ReadString(ASection,KeyRealm,AuthenticationRealm);
+    AuthenticateUserSQL.StrictDelimiter:=True;
+    AuthenticateUserSQL.Delimiter:='&';
+    AuthenticateUserSQL.DelimitedText:=ReadString(ASection,KeySQL,AuthenticateUserSQL.DelimitedText);
+    // optional parts
+    if not (baoSkipPassword in aOptions) then
+      begin
+      if baoSkipMaskPassword in aOptions then
+        P:=ReadString(ASection,KeyPassword,DefaultPassword)
+      else
+        begin
+        P:=ReadString(ASection,KeyPassword,'');
+        if (P<>'') then
+          begin
+          if baoUserNameAsMask in aOptions then
+            M:=DefaultUserName
+          else
+            M:=TrivialEncryptKey;
+          P:=XorDecode(M,P);
+          end;
+        end;
+      DefaultPassword:=P;
+      end;
+    end;
+end;
+
+procedure TSQLDBRestBasicAuthHelper.LoadFromIni(const aIni: TCustomIniFile; aOptions: TBasicAuthIniOptions);
+begin
+  LoadFromIni(aIni,DefaultBasicAuthSection,aOptions);
+end;
+
+procedure TSQLDBRestBasicAuthHelper.LoadFromFile(const aFileName: String; aOptions: TBasicAuthIniOptions);
+
+
+begin
+  Loadfromfile(aFileName,DefaultBasicAuthSection,aOptions);
+end;
+
+procedure TSQLDBRestBasicAuthHelper.LoadFromFile(const aFileName: String; const ASection: String; aOptions: TBasicAuthIniOptions);
+
+Var
+  Ini : TCustomIniFile;
+
+begin
+  Ini:=TMeminiFile.Create(aFileName);
+  try
+    LoadFromIni(Ini,aSection,aOptions);
+  finally
+    Ini.Free;
+  end;
+end;
+
+procedure TSQLDBRestBasicAuthHelper.SaveToFile(const aFileName: String; aOptions: TBasicAuthIniOptions);
+begin
+  SaveToFile(aFileName,DefaultBasicAuthSection,aOptions);
+end;
+
+procedure TSQLDBRestBasicAuthHelper.SaveToFile(const aFileName: String; const ASection: String; aOptions: TBasicAuthIniOptions);
+Var
+  Ini : TCustomIniFile;
+
+begin
+  Ini:=TMeminiFile.Create(aFileName);
+  try
+    SaveToini(Ini,aSection,aOptions);
+    Ini.UpdateFile;
+  finally
+    Ini.Free;
+  end;
+end;
+
+procedure TSQLDBRestBasicAuthHelper.SaveToIni(const aIni: TCustomIniFile; aOptions: TBasicAuthIniOptions);
+begin
+  SaveToIni(aIni,DefaultBasicAuthSection,aOptions);
+end;
+
+procedure TSQLDBRestBasicAuthHelper.SaveToIni(const aIni: TCustomIniFile; ASection: String; aOptions: TBasicAuthIniOptions);
+
+Var
+  M,P : String;
+
+begin
+  With aIni do
+    begin
+    WriteString(ASection,KeyUserName,DefaultUserName);
+    WriteString(ASection,KeyUserID,DefaultUserID);
+    WriteString(ASection,KeyRealm,AuthenticationRealm);
+    AuthenticateUserSQL.StrictDelimiter:=True;
+    AuthenticateUserSQL.Delimiter:='&';
+    WriteString(ASection,KeySQL,AuthenticateUserSQL.DelimitedText);
+    if not (baoSkipPassword in aOptions) then
+      begin
+      P:=DefaultPassword;
+      if Not (baoSkipMaskPassword in aOptions) then
+        begin
+        if baoUserNameAsMask in aOptions then
+          M:=DefaultUserName
+        else
+          M:=TrivialEncryptKey;
+        P:=XorEncode(M,P);
+        end;
+      WriteString(ASection,KeyPassword,P);
+      end;
+    end;
+end;
+
+end.
+

packages/fcl-web/src/restbridge/sqldbrestbridge.pp

@@ -0,0 +1,1804 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2019 by the Free Pascal development team
+
+    SQLDB REST dispatcher component.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit sqldbrestbridge;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, DB, SQLDB, httpdefs, httproute, fpjson, sqldbrestschema, sqldbrestio, sqldbrestdata, sqldbrestauth;
+
+Type
+  TRestDispatcherOption = (rdoConnectionInURL,rdoExposeMetadata,rdoCustomView,rdoHandleCORS);
+  TRestDispatcherOptions = set of TRestDispatcherOption;
+
+Const
+  DefaultDispatcherOptions = [rdoExposeMetadata];
+
+Type
+
+  { TSQLDBRestConnection }
+
+  TSQLDBRestConnection = Class(TCollectionItem)
+  private
+    FCharSet: UTF8String;
+    FConnection: TSQLConnection;
+    FConnectionType: String;
+    FDatabaseName: UTF8String;
+    FEnabled: Boolean;
+    FHostName: UTF8String;
+    FName: UTF8String;
+    FParams: TStrings;
+    FPassword: UTF8String;
+    FPort: Word;
+    FRole: UTF8String;
+    FUserName: UTF8String;
+    FNotifier : TComponent;
+    function GetName: UTF8String;
+    procedure SetConnection(AValue: TSQLConnection);
+    procedure SetParams(AValue: TStrings);
+  Protected
+    Function GetDisplayName: string; override;
+  Public
+    constructor Create(ACollection: TCollection); override;
+    Destructor Destroy; override;
+    Procedure Assign(Source: TPersistent); override;
+  Published
+    // Always use this connection instance
+    Property SingleConnection : TSQLConnection Read FConnection Write SetConnection;
+    // Allow this connection to be used.
+    Property Enabled : Boolean Read FEnabled Write FEnabled default true;
+    // TSQLConnector type
+    property ConnectionType : String Read FConnectionType Write FConnectionType;
+    // Name for this connection
+    Property Name : UTF8String Read GetName Write FName;
+    // Database user password
+    property Password : UTF8String read FPassword write FPassword;
+    // Database username
+    property UserName : UTF8String read FUserName write FUserName;
+    // Database character set
+    property CharSet : UTF8String read FCharSet write FCharSet;
+    // Database hostname
+    property HostName : UTF8String Read FHostName Write FHostName;
+    // Database role
+    Property Role :  UTF8String read FRole write FRole;
+    // Database database name
+    property DatabaseName : UTF8String Read FDatabaseName Write FDatabaseName;
+    // Other parameters
+    Property Params : TStrings Read FParams Write SetParams;
+    // Port DB is listening on
+    Property Port : Word Read FPort Write FPort;
+  end;
+
+  { TSQLDBRestConnectionList }
+
+  TSQLDBRestConnectionList = Class(TCollection)
+  private
+    function GetConn(aIndex : integer): TSQLDBRestConnection;
+    procedure SetConn(aIndex : integer; AValue: TSQLDBRestConnection);
+  Public
+    // Index of connection by name (case insensitive)
+    Function IndexOfConnection(const aName : string) : Integer;
+    // Find connection by name (case insensitive), nil if none found
+    Function FindConnection(const aName : string) :  TSQLDBRestConnection;
+    // Add new instance, setting basic properties. Return new instance
+    Function AddConnection(Const AType,aHostName,aDatabaseName,aUserName,aPassword : UTF8String) : TSQLDBRestConnection;
+    // Save connection definitions to JSON file.
+    Procedure SaveToFile(Const aFileName : UTF8String);
+    // Save connection definitions  to JSON stream
+    Procedure SaveToStream(Const aStream : TStream);
+    // Return connection definitions as JSON object.
+    function AsJSON(const aPropName: UTF8String=''): TJSONData; virtual;
+    // Load connection definitions from JSON file.
+    Procedure LoadFromFile(Const aFileName : UTF8String);
+    // Load connection definitions from JSON stream.
+    Procedure LoadFromStream(Const aStream : TStream);
+    // Load connection definitions from JSON Object.
+    Procedure FromJSON(aData: TJSONData;const aPropName: UTF8String=''); virtual;
+    // Indexed access to connection definitions
+    Property Connections [aIndex : integer] : TSQLDBRestConnection Read GetConn Write SetConn;  default;
+  end;
+
+  { TSQLDBRestSchemaRef }
+
+  TSQLDBRestSchemaRef = Class(TCollectionItem)
+  Private
+    FEnabled: Boolean;
+    Fschema: TSQLDBRestSchema;
+    FNotifier : TComponent;
+    procedure SetSchema(AValue: TSQLDBRestSchema);
+  Protected
+    Function GetDisplayName: String; override;
+  Public
+    Constructor Create(ACollection: TCollection); override;
+    Destructor Destroy; override;
+    Procedure Assign(Source: TPersistent); override;
+  Published
+    // Schema reference
+    Property Schema : TSQLDBRestSchema Read FSchema Write SetSchema;
+    // Allow this schema to be used ?
+    Property Enabled: Boolean Read FEnabled Write FEnabled default true;
+  end;
+
+  { TSQLDBRestSchemaList }
+
+  TSQLDBRestSchemaList = Class(TCollection)
+  private
+    function GetSchema(aIndex : Integer): TSQLDBRestSchemaRef;
+    procedure SetSchema(aIndex : Integer; AValue: TSQLDBRestSchemaRef);
+  Public
+    Function AddSchema (aSchema : TSQLDBRestSchema) : TSQLDBRestSchemaRef;
+    Property Schemas[aIndex :Integer] : TSQLDBRestSchemaRef Read GetSchema Write SetSchema;default;
+  end;
+
+
+
+  { TSQLDBRestDispatcher }
+
+  TResourceAuthorizedEvent = Procedure (Sender : TObject; aRequest : TRequest; Const aResource : UTF8String; var AllowResource : Boolean) of object;
+  TGetConnectionNameEvent = Procedure(Sender : TObject; aRequest : TRequest; Const AResource : String; var AConnectionName : UTF8String) of object;
+  TGetConnectionEvent = Procedure(Sender : TObject; aDef : TSQLDBRestConnection; var aConnection : TSQLConnection) of object;
+  TRestExceptionEvent = Procedure(Sender : TObject; aRequest : TRequest; Const AResource : string; E : Exception) of object;
+  TRestOperationEvent = Procedure(Sender : TObject; aConn: TSQLConnection; aResource : TSQLDBRestResource) of object;
+  TRestGetFormatEvent = Procedure(Sender : TObject; aRest : TRequest; var aFormat : String) of object;
+
+  TSQLDBRestDispatcher = Class(TComponent)
+  Private
+    Class Var FIOClass : TRestIOClass;
+    Class Var FDBHandlerClass : TSQLDBRestDBHandlerClass;
+  private
+    FCORSAllowedOrigins: String;
+    FDispatchOptions: TRestDispatcherOptions;
+    FInputFormat: String;
+    FCustomViewResource : TSQLDBRestResource;
+    FMetadataResource : TSQLDBRestResource;
+    FMetadataDetailResource : TSQLDBRestResource;
+    FActive: Boolean;
+    FAfterDelete: TRestOperationEvent;
+    FAfterGet: TRestOperationEvent;
+    FAfterPost: TRestOperationEvent;
+    FAfterPut: TRestOperationEvent;
+    FAuthenticator: TRestAuthenticator;
+    FBaseURL: UTF8String;
+    FBeforeDelete: TRestOperationEvent;
+    FBeforeGet: TRestOperationEvent;
+    FBeforePost: TRestOperationEvent;
+    FBeforePut: TRestOperationEvent;
+    FConnections: TSQLDBRestConnectionList;
+    FDefaultConnection: UTF8String;
+    FEnforceLimit: Integer;
+    FOnAllowResource: TResourceAuthorizedEvent;
+    FOnBasicAuthentication: TBasicAuthenticationEvent;
+    FOnException: TRestExceptionEvent;
+    FOnGetConnection: TGetConnectionEvent;
+    FOnGetConnectionName: TGetConnectionNameEvent;
+    FOnGetInputFormat: TRestGetFormatEvent;
+    FOnGetOutputFormat: TRestGetFormatEvent;
+    FOutputFormat: String;
+    FOutputOptions: TRestOutputoptions;
+    FSchemas: TSQLDBRestSchemaList;
+    FListRoute: THTTPRoute;
+    FItemRoute: THTTPRoute;
+    FStrings: TRestStringsConfig;
+    procedure SetActive(AValue: Boolean);
+    procedure SetAuthenticator(AValue: TRestAuthenticator);
+    procedure SetConnections(AValue: TSQLDBRestConnectionList);
+    procedure SetSchemas(AValue: TSQLDBRestSchemaList);
+    procedure SetStrings(AValue: TRestStringsConfig);
+  Protected
+    // Auxiliary methods.
+    Procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+    function FindConnection(IO: TRestIO): TSQLDBRestConnection;
+    // Factory methods. Override these to customize various helper classes.
+    function CreateConnection: TSQLConnection; virtual;
+    Function CreateConnectionList : TSQLDBRestConnectionList; virtual;
+    Function CreateSchemaList : TSQLDBRestSchemaList; virtual;
+    function CreateRestStrings: TRestStringsConfig; virtual;
+    function CreateDBHandler(IO: TRestIO): TSQLDBRestDBHandler; virtual;
+    function CreateInputStreamer(IO: TRestIO): TRestInputStreamer; virtual;
+    function CreateOutputStreamer(IO: TRestIO): TRestOutputStreamer; virtual;
+    function CreateIO(aRequest: TRequest; aResponse: TResponse): TRestIO; virtual;
+    function GetInputFormat(IO: TRestIO): String; virtual;
+    function GetOutputFormat(IO: TRestIO): String; virtual;
+    function GetConnectionName(IO: TRestIO): UTF8String;
+    function GetSQLConnection(aConnection: TSQLDBRestConnection; Out aTransaction : TSQLTransaction): TSQLConnection; virtual;
+    procedure DoneSQLConnection(aConnection: TSQLDBRestConnection; AConn: TSQLConnection; aTransaction : TSQLTransaction); virtual;
+    // Error handling
+    procedure CreateErrorContent(IO: TRestIO; aCode: Integer; AExtraMessage: UTF8String); virtual;
+    procedure HandleException(E: Exception; IO: TRestIO); virtual;
+    // REST request processing
+    // Extract REST operation type from request
+    procedure SetDefaultResponsecode(IO: TRestIO); virtual;
+    // Must set result code and WWW-Authenticate header when applicable
+    Function AuthenticateRequest(IO : TRestIO; Delayed : Boolean) : Boolean; virtual;
+    function ExtractRestOperation(aRequest: TRequest;AccessControl : Boolean = false): TRestoperation; virtual;
+    function FindRestResource(aResource: UTF8String): TSQLDBRestResource; virtual;
+    function AllowRestResource(aIO : TRestIO): Boolean; virtual;
+    function ExtractRestResourceName(IO: TRestIO): UTF8String; virtual;
+    // Override if you want to create non-sqldb based resources
+    function CreateSpecialResourceDataset(IO: TRestIO; AOwner: TComponent): TDataset; virtual;
+    function IsSpecialResource(aResource: TSQLDBRestResource): Boolean; virtual;
+    function FindSpecialResource(IO: TRestIO; aResource: UTF8String): TSQLDBRestResource; virtual;
+    // Special resources for Metadata handling
+    function CreateMetadataDataset(IO: TRestIO; AOwner: TComponent): TDataset; virtual;
+    function CreateMetadataDetailDataset(IO: TRestIO; Const aResourceName : String; AOwner: TComponent): TDataset; virtual;
+    function CreateMetadataDetailResource: TSQLDBRestResource;  virtual;
+    function CreateMetadataResource: TSQLDBRestResource; virtual;
+    // Custom view handling
+    function CreateCustomViewResource: TSQLDBRestResource; virtual;
+    function CreateCustomViewDataset(IO: TRestIO; const aSQL: String; AOwner: TComponent): TDataset;
+    procedure ResourceToDataset(R: TSQLDBRestResource; D: TDataset); virtual;
+    procedure SchemasToDataset(D: TDataset);virtual;
+    // General HTTP handling
+    procedure DoRegisterRoutes; virtual;
+    procedure DoHandleEvent(IsBefore : Boolean;IO: TRestIO); virtual;
+    procedure HandleCORSRequest(aConnection: TSQLDBRestConnection; IO: TRestIO); virtual;
+    procedure HandleResourceRequest(aConnection : TSQLDBRestConnection; IO: TRestIO); virtual;
+    procedure DoHandleRequest(IO: TRestIO); virtual;
+  Public
+    Class Procedure SetIOClass (aClass: TRestIOClass);
+    Class Procedure SetDBHandlerClass (aClass: TSQLDBRestDBHandlerClass);
+    Constructor Create(AOWner : TComponent); override;
+    Destructor Destroy; override;
+    procedure RegisterRoutes;
+    procedure UnRegisterRoutes;
+    procedure HandleRequest(aRequest : TRequest; aResponse : TResponse);
+    Function ExposeDatabase(Const aType,aHostName,aDatabaseName,aUserName,aPassword : String; aTables : Array of String; aMinFieldOpts : TRestFieldOptions = []) : TSQLDBRestConnection;
+    Function ExposeDatabase(Const aType,aHostName,aDatabaseName,aUserName,aPassword : String; aTables : TStrings = nil; aMinFieldOpts : TRestFieldOptions = []) : TSQLDBRestConnection;
+    Function ExposeConnection(aOwner : TComponent; Const aConnection : TSQLDBRestConnection; aTables : TStrings = nil; aMinFieldOpts : TRestFieldOptions = []) : TSQLDBRestSchema;
+    Function ExposeConnection(Const aConnection : TSQLDBRestConnection; aTables : TStrings = nil; aMinFieldOpts : TRestFieldOptions = []) : TSQLDBRestSchema;
+  Published
+    // Register or unregister HTTP routes
+    Property Active : Boolean Read FActive Write SetActive;
+    // List of database connections to connect to
+    Property Connections : TSQLDBRestConnectionList Read FConnections Write SetConnections;
+    // List of REST schemas to serve
+    Property Schemas : TSQLDBRestSchemaList Read FSchemas Write SetSchemas;
+    // Base URL
+    property BasePath : UTF8String Read FBaseURL Write FBaseURL;
+    // Default connection to use if none is detected from request/schema
+    Property DefaultConnection : UTF8String Read FDefaultConnection Write FDefaultConnection;
+    // Input/Output strings configuration
+    Property Strings : TRestStringsConfig Read FStrings Write SetStrings;
+    // default Output options, modifiable by query.
+    Property OutputOptions : TRestOutputOptions Read FOutputOptions Write FOutputOptions Default allOutputOptions;
+    // Set this to allow only this input format.
+    Property InputFormat : String Read FInputFormat Write FInputFormat;
+    // Set this to allow only this output format.
+    Property OutputFormat : String Read FOutputFormat Write FOutputFormat;
+    // Dispatcher options
+    Property DispatchOptions : TRestDispatcherOptions Read FDispatchOptions Write FDispatchOptions default DefaultDispatcherOptions;
+    // Authenticator for requests
+    Property Authenticator : TRestAuthenticator Read FAuthenticator Write SetAuthenticator;
+    // If >0, Enforce a limit on output results.
+    Property EnforceLimit : Integer Read FEnforceLimit Write FEnforceLimit;
+    // Domains that are allowed to use this REST service
+    Property CORSAllowedOrigins: String Read FCORSAllowedOrigins  Write FCORSAllowedOrigins;
+    // Called when Basic authentication is sufficient.
+    Property OnBasicAuthentication : TBasicAuthenticationEvent Read FOnBasicAuthentication Write FOnBasicAuthentication;
+    // Allow a particular resource or not.
+    Property OnAllowResource : TResourceAuthorizedEvent Read FOnAllowResource Write FonAllowResource;
+    // Called when determining the connection name for a request.
+    Property OnGetConnectionName : TGetConnectionNameEvent Read FOnGetConnectionName Write FOnGetConnectionName;
+    // Called when an exception happened during treatment of request.
+    Property OnException : TRestExceptionEvent Read FOnException Write FOnException;
+    // Called to get an actual connection.
+    Property OnGetConnection : TGetConnectionEvent Read FOnGetConnection Write FOnGetConnection;
+    // Called to determine input format based on request.
+    Property OnGetInputFormat : TRestGetFormatEvent Read FOnGetInputFormat Write FOnGetInputFormat;
+    // Called to determine output format based on request.
+    Property OnGetOutputFormat : TRestGetFormatEvent Read FOnGetInputFormat Write FOnGetOutputFormat;
+    // Called before a GET request.
+    Property BeforeGet : TRestOperationEvent Read FBeforeGet Write FBeforeGet;
+    // Called After a GET request.
+    Property AfterGet : TRestOperationEvent Read FAfterGet Write FAfterGet;
+    // Called before a PUT request.
+    Property BeforePut : TRestOperationEvent Read FBeforePut Write FBeforePut;
+    // Called After a PUT request.
+    Property AfterPut : TRestOperationEvent Read FAfterPut Write FAfterPut;
+    // Called before a POST request.
+    Property BeforePost : TRestOperationEvent Read FBeforePost Write FBeforePost;
+    // Called After a POST request.
+    Property AfterPost : TRestOperationEvent Read FAfterPost Write FAfterPost;
+    // Called before a DELETE request.
+    Property BeforeDelete : TRestOperationEvent Read FBeforeDelete Write FBeforeDelete;
+    // Called After a DELETE request.
+    Property AfterDelete : TRestOperationEvent Read FAfterDelete Write FAfterDelete;
+  end;
+
+
+
+implementation
+
+uses fpjsonrtti, DateUtils, bufdataset, sqldbrestjson, sqldbrestconst;
+
+Type
+
+  { TRestBufDataset }
+
+  TRestBufDataset = class (TBufDataset)
+  protected
+    procedure LoadBlobIntoBuffer(FieldDef: TFieldDef; ABlobBuf: PBufBlobField); override;
+  end;
+
+
+  { TSchemaFreeNotifier }
+
+  TSchemaFreeNotifier = Class(TComponent)
+    FRef : TSQLDBRestSchemaRef;
+    Procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+  end;
+
+  { TConnectionFreeNotifier }
+
+  TConnectionFreeNotifier = Class(TComponent)
+    FRef : TSQLDBRestConnection;
+    Procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+  end;
+
+{ TRestBufDataset }
+
+procedure TRestBufDataset.LoadBlobIntoBuffer(FieldDef: TFieldDef; ABlobBuf: PBufBlobField);
+begin
+  If (FieldDef=Nil) or (aBlobBuf=Nil) then
+    exit;
+end;
+
+
+
+
+
+{ TConnectionFreeNotifier }
+
+procedure TConnectionFreeNotifier.Notification(AComponent: TComponent; Operation: TOperation);
+begin
+  inherited Notification(AComponent, Operation);
+  if (Operation=opRemove) and Assigned(FRef) and (Fref.SingleConnection=aComponent) then
+    Fref.SingleConnection:=Nil;
+end;
+
+{ TSQLDBRestSchemaList }
+
+function TSQLDBRestSchemaList.GetSchema(aIndex : Integer): TSQLDBRestSchemaRef;
+begin
+  Result:=TSQLDBRestSchemaRef(Items[aIndex]);
+end;
+
+procedure TSQLDBRestSchemaList.SetSchema(aIndex : Integer; AValue: TSQLDBRestSchemaRef);
+begin
+  Items[aIndex]:=aValue;
+end;
+
+function TSQLDBRestSchemaList.AddSchema(aSchema: TSQLDBRestSchema): TSQLDBRestSchemaRef;
+begin
+  Result:=(Add as TSQLDBRestSchemaRef);
+  Result.Schema:=aSchema;
+  Result.Enabled:=True;
+end;
+
+{ TSQLDBRestDispatcher }
+
+procedure TSQLDBRestDispatcher.SetConnections(AValue: TSQLDBRestConnectionList);
+begin
+  if FConnections=AValue then Exit;
+  FConnections.Assign(AValue);
+end;
+
+procedure TSQLDBRestDispatcher.SetActive(AValue: Boolean);
+begin
+  if FActive=AValue then Exit;
+  if AValue then
+    DoRegisterRoutes
+  else
+    UnRegisterRoutes;
+  FActive:=AValue;
+
+end;
+
+procedure TSQLDBRestDispatcher.SetAuthenticator(AValue: TRestAuthenticator);
+begin
+  if FAuthenticator=AValue then Exit;
+  if Assigned(FAuthenticator) then
+    FAuthenticator.RemoveFreeNotification(Self);
+  FAuthenticator:=AValue;
+  if Assigned(FAuthenticator) then
+    FAuthenticator.FreeNotification(Self);
+end;
+
+procedure TSQLDBRestDispatcher.SetSchemas(AValue: TSQLDBRestSchemaList);
+begin
+  if FSchemas=AValue then Exit;
+  FSchemas.Assign(AValue);
+end;
+
+procedure TSQLDBRestDispatcher.SetStrings(AValue: TRestStringsConfig);
+begin
+  if FStrings=AValue then Exit;
+  FStrings.Assign(AValue);
+end;
+
+procedure TSQLDBRestDispatcher.DoRegisterRoutes;
+
+Var
+  Res : String;
+
+begin
+  Res:=IncludeHTTPPathDelimiter(BasePath);
+  if rdoConnectionInURL in DispatchOptions then
+    Res:=Res+':connection/';
+  Res:=Res+':resource';
+  FListRoute:=HTTPRouter.RegisterRoute(res,@HandleRequest);
+  FItemRoute:=HTTPRouter.RegisterRoute(Res+'/:id',@HandleRequest);
+end;
+
+function TSQLDBRestDispatcher.GetInputFormat(IO : TRestIO) : String;
+
+// Order is: InputFormat setting, Content-type, input format, output format if it exists as input
+
+Var
+  U : UTF8String;
+  D : TStreamerDef;
+
+begin
+  Result:=InputFormat;
+  if (Result='') then
+    begin
+    if Result='' then
+      if IO.GetVariable(Fstrings.GetRestString(rpInputFormat),U,[vsQuery])<>vsNone then
+        Result:=U;
+    if (Result='') and (IO.Request.ContentType<>'') then
+      begin
+      D:=TStreamerFactory.Instance.FindStreamerByContentType(rstInput,IO.Request.ContentType);
+      if D<>Nil then
+        Result:=D.MyName;
+      end;
+    if (Result='') then
+      if IO.GetVariable(Fstrings.GetRestString(rpOutputFormat),U,[vsQuery])<>vsNone then
+        begin
+        if TStreamerFactory.Instance.FindStreamerByName(rstInput,U)<>Nil then
+          Result:=U;
+        end;
+    end;
+  If Assigned(FOnGetInputFormat) then
+    FOnGetInputFormat(Self,IO.Request,Result)
+end;
+
+function TSQLDBRestDispatcher.GetOutputFormat(IO : TRestIO) : String;
+
+// Order is: OutputFormat setting, output format, input Content-type, input format if it exists as output
+
+Var
+  U : UTF8String;
+  D : TStreamerDef;
+
+begin
+  Result:=OutputFormat;
+  if (Result='') then
+    begin
+    if IO.GetVariable(Fstrings.GetRestString(rpOutputFormat),U,[vsQuery])<>vsNone then
+      Result:=U;
+    if (Result='') and (IO.Request.ContentType<>'') then
+      begin
+      D:=TStreamerFactory.Instance.FindStreamerByContentType(rstOutput,IO.Request.ContentType);
+      if D<>Nil then
+        Result:=D.MyName;
+      end;
+    if Result='' then
+      if IO.GetVariable(Fstrings.GetRestString(rpInputFormat),U,[vsQuery])<>vsNone then
+        begin
+        if TStreamerFactory.Instance.FindStreamerByName(rstOutput,U)<>Nil then
+          Result:=U;
+        end;
+    end;
+  If Assigned(FOnGetOutputFormat) then
+    FOnGetOutputFormat(Self,IO.Request,Result)
+end;
+
+function TSQLDBRestDispatcher.CreateInputStreamer(IO : TRestIO): TRestInputStreamer;
+
+Var
+  D : TStreamerDef;
+  aName : String;
+
+begin
+  aName:=GetInputFormat(IO);
+  if aName='' then
+    aName:='json';
+  D:=TStreamerFactory.Instance.FindStreamerByName(rstInput,aName);
+  if (D=Nil) then
+    Raise ESQLDBRest.CreateFmt(400,SErrUnknownOrUnSupportedFormat,[aName]);
+  Result:=TRestInputStreamer(D.MyClass.Create(IO.RequestContentStream,Fstrings,@IO.DoGetVariable));
+end;
+
+function TSQLDBRestDispatcher.CreateOutputStreamer(IO : TRestIO): TRestOutputStreamer;
+
+Var
+  D : TStreamerDef;
+  aName : String;
+
+begin
+  aName:=GetOutputFormat(IO);
+  if aName='' then
+    aName:='json';
+  D:=TStreamerFactory.Instance.FindStreamerByName(rstOutput,aName);
+  if (D=Nil) then
+    Raise ESQLDBRest.CreateFmt(400,SErrUnknownOrUnSupportedFormat,[aName]);
+  Result:=TRestOutputStreamer(D.MyClass.Create(IO.Response.ContentStream,Fstrings,@IO.DoGetVariable));
+end;
+
+
+function TSQLDBRestDispatcher.CreateIO(aRequest: TRequest; aResponse: TResponse): TRestIO;
+
+Var
+  aInput : TRestInputStreamer;
+  aOutput : TRestOutputStreamer;
+
+begin
+  aInput:=Nil;
+  aOutput:=Nil;
+  Result:=FIOClass.Create(aRequest,aResponse);
+  try
+    // Set up output
+    Result.Response.ContentStream:=TMemoryStream.Create;
+    Result.Response.FreeContentStream:=True;
+    Result.SetRestStrings(FStrings);
+    aInput:=CreateInputStreamer(Result);
+    aoutPut:=CreateOutPutStreamer(Result);
+    Result.SetIO(aInput,aOutput);
+    aInput:=Nil;
+    aOutput:=Nil;
+    aResponse.ContentType:=Result.RestOutput.GetContentType;
+    Result.RestOutput.OutputOptions:=Result.GetRequestOutputOptions(OutputOptions);
+  except
+    On E : Exception do
+      begin
+      FreeAndNil(aInput);
+      FreeAndNil(aOutput);
+      FreeAndNil(Result);
+      Raise;
+      end;
+  end;
+end;
+
+procedure TSQLDBRestDispatcher.CreateErrorContent(IO : TRestIO; aCode : Integer; AExtraMessage: UTF8String);
+
+begin
+  IO.Response.Code:=aCode;
+  IO.Response.CodeText:=aExtraMessage;
+  IO.RestOutput.CreateErrorContent(aCode,aExtraMessage);
+  IO.Response.SendResponse;
+end;
+
+class procedure TSQLDBRestDispatcher.SetIOClass(aClass: TRestIOClass);
+
+begin
+  FIOClass:=aClass;
+  if FIOClass=Nil then
+    FIOClass:=TRestIO;
+end;
+
+class procedure TSQLDBRestDispatcher.SetDBHandlerClass(aClass: TSQLDBRestDBHandlerClass);
+
+begin
+  FDBHandlerClass:=aClass;
+  if FDBHandlerClass=Nil then
+    FDBHandlerClass:=TSQLDBRestDBHandler;
+end;
+
+constructor TSQLDBRestDispatcher.Create(AOWner: TComponent);
+begin
+  inherited Create(AOWner);
+  FStrings:=CreateRestStrings;
+  FConnections:=CreateConnectionList;
+  FSchemas:=CreateSchemaList;
+  FOutputOptions:=allOutputOptions;
+  FDispatchOptions:=DefaultDispatcherOptions;
+end;
+
+destructor TSQLDBRestDispatcher.Destroy;
+begin
+  Authenticator:=Nil;
+  FreeAndNil(FCustomViewResource);
+  FreeAndNil(FMetadataResource);
+  FreeAndNil(FMetadataDetailResource);
+  FreeAndNil(FSchemas);
+  FreeAndNil(FConnections);
+  FreeAndNil(FStrings);
+  inherited Destroy;
+end;
+
+function TSQLDBRestDispatcher.CreateRestStrings : TRestStringsConfig;
+
+begin
+  Result:=TRestStringsConfig.Create
+end;
+
+function TSQLDBRestDispatcher.ExtractRestResourceName(IO: TRestIO): UTF8String;
+
+begin
+  Result:=IO.Request.RouteParams['resource'];
+  if (Result='') then
+    Result:=IO.Request.QueryFields.Values[Strings.ResourceParam];
+end;
+
+function TSQLDBRestDispatcher.AllowRestResource( aIO: TRestIO): Boolean;
+
+begin
+  Result:=True;
+  if Assigned(FOnAllowResource) then
+    FOnAllowResource(Self,aIO.Request,aIO.ResourceName,Result);
+end;
+
+
+function TSQLDBRestDispatcher.CreateCustomViewResource: TSQLDBRestResource;
+
+begin
+  Result:=TCustomViewResource.Create(Nil);
+  Result.ResourceName:=FStrings.GetRestString(rpCustomViewResourceName);
+  Result.AllowedOperations:=[roGet];
+end;
+
+function TSQLDBRestDispatcher.CreateMetadataResource: TSQLDBRestResource;
+
+Var
+  O : TRestOperation;
+  S : String;
+
+begin
+  Result:=TSQLDBRestResource.Create(Nil);
+  Result.ResourceName:='metaData';
+  Result.AllowedOperations:=[roGet];
+  Result.Fields.AddField('name',rftString,[foRequired]);
+  Result.Fields.AddField('schemaName',rftString,[foRequired]);
+  for O in TRestOperation do
+    if O<>roUnknown then
+      begin
+      Str(O,S);
+      delete(S,1,2);
+      Result.Fields.AddField(S,rftBoolean,[foRequired]);
+      end;
+end;
+
+function TSQLDBRestDispatcher.CreateMetadataDetailResource: TSQLDBRestResource;
+
+Var
+  O : TRestFieldOption;
+  S : String;
+
+begin
+  Result:=TSQLDBRestResource.Create(Nil);
+  Result.ResourceName:='metaDataField';
+  Result.AllowedOperations:=[roGet];
+  Result.Fields.AddField('name',rftString,[]);
+  Result.Fields.AddField('type',rftString,[]);
+  Result.Fields.AddField('maxlen',rftInteger,[]);
+  Result.Fields.AddField('format',rftString,[]);
+  for O in TRestFieldOption do
+    begin
+    Str(O,S);
+    delete(S,1,2);
+    Result.Fields.AddField(S,rftBoolean,[]);
+    end;
+end;
+
+function TSQLDBRestDispatcher.FindSpecialResource(IO : TRestIO; aResource: UTF8String): TSQLDBRestResource;
+
+  Function IsCustomView : Boolean;inline;
+
+  begin
+    Result:=(rdoCustomView in DispatchOptions)
+            and SameText(aResource,Strings.GetRestString(rpCustomViewResourceName));
+  end;
+  Function IsMetadata : Boolean;inline;
+
+  begin
+    Result:=(rdoExposeMetadata in DispatchOptions)
+            and SameText(aResource,Strings.GetRestString(rpMetaDataResourceName));
+  end;
+
+Var
+  N : UTF8String;
+
+begin
+  Result:=Nil;
+  If isCustomView then
+    begin
+    if FCustomViewResource=Nil then
+      FCustomViewResource:=CreateCustomViewResource;
+    Result:=FCustomViewResource;
+    end
+  else If isMetadata then
+    if (IO.GetVariable('ID',N,[vsRoute,vsQuery])=vsNone) then
+      begin
+      if FMetadataResource=Nil then
+        FMetadataResource:=CreateMetadataResource;
+      Result:=FMetadataResource;
+      end
+    else
+      begin
+      if FindRestResource(N)<>Nil then
+        begin
+        if FMetadataDetailResource=Nil then
+          FMetadataDetailResource:=CreateMetadataDetailResource;
+        Result:=FMetadataDetailResource;
+        end;
+      end
+
+end;
+
+function TSQLDBRestDispatcher.FindRestResource(aResource: UTF8String): TSQLDBRestResource;
+
+Var
+  I : integer;
+
+begin
+  Result:=Nil;
+  I:=0;
+  While (Result=Nil) and (I<Schemas.Count) do
+    begin
+    if Schemas[i].Enabled then
+      Result:=Schemas[i].Schema.Resources.FindResourceByName(aResource);
+    Inc(I);
+    end;
+end;
+
+function TSQLDBRestDispatcher.ExtractRestOperation(aRequest: TRequest;AccessControl : Boolean = false): TRestoperation;
+
+Var
+  M : String;
+
+begin
+  Result:=roUnknown;
+  if not AccessControl then
+    M:=aRequest.Method
+  else
+    M:=aRequest.CustomHeaders.Values['Access-Control-Request-Method'];
+  Case lowercase(M) of
+    'get' : Result:=roGet;
+    'put' : Result:=roPut;
+    'post' : Result:=roPost;
+    'delete' : Result:=roDelete;
+    'options' : Result:=roOptions;
+    'head' : Result:=roHead;
+  end;
+end;
+
+Type
+
+  { TRestSQLConnector }
+
+  { THackSQLConnector }
+
+  THackSQLConnector = Class(TSQLConnection)
+  Public
+    function DoGetNextValueSQL(const SequenceName: string; IncrementBy: Integer): string;
+  end;
+  TRestSQLConnector = Class(TSQLConnector)
+  Private
+    FUse : Integer;
+    FRequestCount : INteger;
+  Protected
+    function GetNextValueSQL(const SequenceName: string; IncrementBy: Integer): string; override;
+    Procedure StartUsing;
+    Function DoneUsing : Boolean;
+  end;
+
+{ THackSQLConnector }
+
+function THackSQLConnector.DoGetNextValueSQL(const SequenceName: string; IncrementBy: Integer): string;
+begin
+  Result:=GetNextValueSQL(SequenceName,IncrementBy);
+end;
+
+{ TRestSQLConnector }
+
+function TRestSQLConnector.GetNextValueSQL(const SequenceName: string; IncrementBy: Integer): string;
+begin
+  Result:=THackSQLConnector(Proxy).DoGetNextValueSQL(SequenceName, IncrementBy);
+end;
+
+procedure TRestSQLConnector.StartUsing;
+begin
+  InterLockedIncrement(FUse);
+  Inc(FRequestCount);
+end;
+
+function TRestSQLConnector.DoneUsing: Boolean;
+begin
+  InterLockedDecrement(Fuse);
+  Result:=(FRequestCount>100) and (FUse=0);
+end;
+
+function TSQLDBRestDispatcher.CreateConnection : TSQLConnection;
+
+begin
+  Result:=TRestSQLConnector.Create(Self);
+end;
+
+function TSQLDBRestDispatcher.GetSQLConnection(
+  aConnection: TSQLDBRestConnection; out aTransaction: TSQLTransaction
+  ): TSQLConnection;
+
+begin
+  Result:=aConnection.SingleConnection;
+  if (Result=Nil) then
+    begin
+    if Assigned(OnGetConnection) then
+      OnGetConnection(Self,aConnection,Result);
+    if (Result=Nil) then
+      begin
+      Result:=CreateConnection;
+      Result.CharSet:=aConnection.CharSet;
+      Result.HostName:=aConnection.HostName;
+      Result.DatabaseName:=aConnection.DatabaseName;
+      Result.UserName:=aConnection.UserName;
+      Result.Password:=aConnection.Password;
+      Result.Params:=Aconnection.Params;
+      if Result is TRestSQLConnector then
+        TRestSQLConnector(Result).ConnectorType:=aConnection.ConnectionType;
+      aConnection.SingleConnection:=Result;
+      end;
+    end;
+  If (Result is TRestSQLConnector) then
+    TRestSQLConnector(Result).StartUsing;
+  aTransaction:=TSQLTransaction.Create(Self);
+  aTransaction.Database:=Result;
+end;
+
+procedure TSQLDBRestDispatcher.DoHandleEvent(IsBefore: Boolean; IO: TRestIO);
+
+Var
+  R : TRestOperationEvent;
+
+begin
+  R:=Nil;
+  if isBefore then
+    Case IO.Operation of
+      roGet : R:=FBeforeGet;
+      roPut : R:=FBeforePut;
+      roPost : R:=FBeforePost;
+      roDelete : R:=FBeforeDelete;
+    end
+  else
+    Case IO.Operation of
+      roGet : R:=FAfterGet;
+      roPut : R:=FAfterPut;
+      roPost : R:=FAfterPost;
+      roDelete : R:=FAfterDelete;
+    end;
+  If Assigned(R) then
+    R(Self,IO.Connection,IO.Resource)
+end;
+
+
+
+procedure TSQLDBRestDispatcher.DoneSQLConnection(
+  aConnection: TSQLDBRestConnection; AConn: TSQLConnection;
+  aTransaction: TSQLTransaction);
+
+Var
+  NeedNil : Boolean;
+
+begin
+  FreeAndNil(aTransaction);
+  if (aConn is TRestSQLConnector) then
+    begin
+    NeedNil:= (aConnection.SingleConnection=aConn) ;
+    if TRestSQLConnector(aConn).DoneUsing then
+      FreeAndNil(aConn);
+    If NeedNil then
+      aConnection.SingleConnection:=Nil;
+    end;
+end;
+
+
+function TSQLDBRestDispatcher.CreateDBHandler(IO: TRestIO): TSQLDBRestDBHandler;
+
+begin
+  Result:=FDBHandlerClass.Create(Self) ;
+  Result.Init(IO,FStrings,TSQLQuery);
+  Result.EnforceLimit:=Self.EnforceLimit;
+end;
+
+
+procedure TSQLDBRestDispatcher.SetDefaultResponsecode(IO : TRestIO);
+
+Const
+  DefaultCodes : Array[TRestOperation] of Integer = (500,200,201,200,204,200,200);
+  DefaultTexts : Array[TRestOperation] of string = ('Internal Error','OK','Created','OK','No content','OK','OK');
+
+Var
+  aCode : Integer;
+  aText : String;
+
+begin
+  aCode:=DefaultCodes[IO.Operation];
+  aText:=DefaultTexts[IO.Operation];
+  if IO.Response.Code=0 then
+    IO.Response.Code:=aCode;
+  if (IO.Response.CodeText='') then
+    IO.Response.CodeText:=aText;
+end;
+
+function TSQLDBRestDispatcher.IsSpecialResource(aResource: TSQLDBRestResource
+  ): Boolean;
+
+begin
+  Result:=(aResource<>Nil);
+  if not Result then exit;
+  Result:=(aResource=FMetadataResource) or
+          (aResource=FMetadataDetailResource) or
+          (aResource=FCustomViewResource);
+end;
+
+
+procedure TSQLDBRestDispatcher.SchemasToDataset(D: TDataset);
+
+Var
+  S : TSQLDBRestSchema;
+  R : TSQLDBRestResource;
+  O : TRestOperation;
+  I,J : Integer;
+  SO : String;
+  FName,FSchema : TField;
+  FOperations : Array[TRestOperation] of TField;
+
+begin
+  FName:=D.FieldByName('name');
+  FSchema:=D.FieldByName('schemaName');
+  for O in TRestOperation do
+    if O<>roUnknown then
+      begin
+      Str(O,SO);
+      delete(SO,1,2);
+      FOperations[O]:=D.FieldByName(SO);
+      end;
+  For I:=0 to Schemas.Count-1 do
+    if Schemas[I].Enabled then
+      begin
+      S:=Schemas[I].Schema;
+      For J:=0 to S.Resources.Count-1 do
+        begin
+        R:=S.Resources[J];
+        if R.Enabled and R.InMetadata then
+          begin
+          D.Append;
+          FName.AsString:=R.ResourceName;
+          FSchema.AsString:=S.Name;
+          for O in TRestOperation do
+            if O<>roUnknown then
+              FOperations[O].AsBoolean:=O in R.AllowedOperations;
+          end;
+        D.Post;
+        end;
+      end;
+end;
+
+function TSQLDBRestDispatcher.CreateMetadataDataset(IO: TRestIO;
+  AOwner: TComponent): TDataset;
+
+Var
+  BD :  TRestBufDataset;
+  O : TRestOperation;
+  SO : String;
+
+begin
+  if IO=Nil then exit;
+  BD:=TRestBufDataset.Create(aOwner);
+  try
+    Result:=BD;
+    Result.FieldDefs.Add('name',ftString,255,False);
+    Result.FieldDefs.Add('schemaName',ftString,255,False);
+    for O in TRestOperation do
+      if O<>roUnknown then
+        begin
+        Str(O,SO);
+        delete(SO,1,2);
+        Result.FieldDefs.Add(SO,ftBoolean,0,False);
+        end;
+    BD.CreateDataset;
+    SchemasToDataset(BD);
+    BD.First;
+  except
+    BD.Free;
+    Raise;
+  end;
+end;
+
+procedure TSQLDBRestDispatcher.ResourceToDataset(R: TSQLDBRestResource;
+  D: TDataset);
+
+Var
+  F : TSQLDBRestField;
+  O : TRestFieldOption;
+  I : Integer;
+  SO : String;
+  FName,FType,fMaxLen,fFormat : TField;
+  FOptions : Array[TRestFieldOption] of TField;
+
+begin
+  FName:=D.FieldByName('name');
+  FType:=D.FieldByName('type');
+  FMaxLen:=D.FieldByName('maxlen');
+  FFormat:=D.FieldByName('format');
+  for O in TRestFieldOption do
+    begin
+    Str(O,SO);
+    delete(SO,1,2);
+    FOptions[O]:=D.FieldByName(SO);
+    end;
+  For I:=0 to R.Fields.Count-1 do
+    begin
+    F:=R.Fields[i];
+    D.Append;
+    FName.AsString:=F.PublicName;
+    Ftype.AsString:=TypeNames[F.FieldType];
+    FMaxLen.AsInteger:=F.MaxLen;
+    Case F.FieldType of
+      rftDate : FFormat.AsString:=FStrings.GetRestString(rpDateFormat);
+      rftDateTime : FFormat.AsString:=FStrings.GetRestString(rpDatetimeFormat);
+      rftTime : FFormat.AsString:=FStrings.GetRestString(rpTimeFormat);
+    end;
+    for O in TRestFieldOption do
+      FOptions[O].AsBoolean:=O in F.Options;
+    D.Post;
+    end;
+end;
+
+function TSQLDBRestDispatcher.CreateMetadataDetailDataset(IO: TRestIO;
+  const aResourceName: String; AOwner: TComponent): TDataset;
+
+Var
+  BD :  TRestBufDataset;
+  O : TRestFieldOption;
+  SO : String;
+  R : TSQLDBRestResource;
+
+begin
+  if IO=Nil then exit;
+  BD:=TRestBufDataset.Create(aOwner);
+  try
+    Result:=BD;
+    Result.FieldDefs.Add('name',ftString,255,False);
+    Result.FieldDefs.Add('type',ftString,255,False);
+    Result.FieldDefs.Add('maxlen',ftInteger,0,false);
+    Result.FieldDefs.Add('format',ftString,50,false);
+    for O in TRestFieldOption do
+      begin
+      Str(O,SO);
+      delete(SO,1,2);
+      Result.FieldDefs.Add(SO,ftBoolean,0,False);
+      end;
+    BD.CreateDataset;
+    R:=FindRestResource(aResourceName);
+    ResourceToDataset(R,BD);
+    BD.First;
+  except
+    BD.Free;
+    Raise;
+  end;
+end;
+
+function TSQLDBRestDispatcher.CreateCustomViewDataset(IO: TRestIO;
+  const aSQL: String; AOwner: TComponent): TDataset;
+
+Var
+  Q : TRestSQLQuery;
+  ST : TStatementType;
+
+begin
+  ST:=IO.Connection.GetStatementInfo(aSQL).StatementType;
+  if (st<>stSelect) then
+    Raise ESQLDBRest.Create(400,'Only SELECT SQL is allowed for custom view'); // Should never happen.
+  Q:=TRestSQLQuery.Create(aOwner);
+  try
+    Q.DataBase:=IO.Connection;
+    Q.Transaction:=IO.Transaction;
+    Q.ParseSQL:=True;
+    Q.SQL.Text:=aSQL;
+    Result:=Q;
+  except
+    Q.Free;
+    Raise;
+  end;
+end;
+
+
+function TSQLDBRestDispatcher.CreateSpecialResourceDataset(IO: TRestIO;
+  AOwner: TComponent): TDataset;
+
+Var
+  RN : UTF8String;
+
+begin
+  Result:=Nil;
+  if (IO.Resource=FMetadataResource) then
+    Result:=CreateMetadataDataset(IO,AOwner)
+  else if (IO.Resource=FMetadataDetailResource) then
+    begin
+    if IO.GetVariable('ID',RN,[vsRoute,vsQuery])=vsNone then
+      Raise ESQLDBRest.Create(500,'Could not find resource name'); // Should never happen.
+    Result:=CreateMetadataDetailDataset(IO,RN,AOwner)
+    end
+  else   if (IO.Resource=FCustomViewResource) then
+    begin
+    if IO.GetVariable(FStrings.GetRestString(rpCustomViewSQLParam),RN,[vsRoute,vsQuery])=vsNone then
+      Raise ESQLDBRest.Create(400,'Could not find SQL statement for custom view'); // Should never happen.
+    Result:=CreateCustomViewDataset(IO,RN,aOwner);
+    end
+
+end;
+
+procedure TSQLDBRestDispatcher.HandleCORSRequest(aConnection : TSQLDBRestConnection; IO : TRestIO);
+
+Var
+  S : String;
+  Allowed : Boolean;
+
+
+begin
+  Allowed:=(rdoHandleCORS in DispatchOptions) and (roOptions in IO.Resource.AllowedOperations);
+  if Allowed then
+    Allowed:=(ExtractRestOperation(IO.Request,True) in ([roUnknown]+IO.Resource.AllowedOperations));
+  if not Allowed then
+    begin
+    IO.Response.Code:=403;
+    IO.Response.CodeText:='FORBIDDEN';
+    IO.CreateErrorResponse;
+    end
+  else
+    begin
+    S:=FCORSAllowedOrigins;
+    if S='' then
+      S:='*';
+    IO.Response.SetCustomHeader('Access-Control-Allow-Origin',S);
+    S:=IO.Resource.GetHTTPAllow;
+    IO.Response.SetCustomHeader('Access-Control-Allow-Methods',S);
+    IO.Response.Code:=200;
+    IO.Response.CodeText:='OK';
+    end;
+end;
+
+procedure TSQLDBRestDispatcher.HandleResourceRequest(aConnection : TSQLDBRestConnection; IO : TRestIO);
+
+Var
+  Conn : TSQLConnection;
+  TR : TSQLTransaction;
+  H : TSQLDBRestDBHandler;
+  l,o : Int64;
+
+begin
+  H:=Nil;
+  Conn:=GetSQLConnection(aConnection,Tr);
+  try
+    IO.SetConn(Conn,TR);
+    Try
+      if not AuthenticateRequest(IO,True) then
+        exit;
+      DoHandleEvent(True,IO);
+      H:=CreateDBHandler(IO);
+      if IsSpecialResource(IO.Resource) then
+        begin
+        H.ExternalDataset:=CreateSpecialResourceDataset(IO,H);
+        if (IO.Resource=FCustomViewResource) then
+          H.DeriveResourceFromDataset:=True;
+        H.EmulateOffsetLimit:=IO.GetLimitOffset(EnforceLimit,l,o);
+        end;
+      H.ExecuteOperation;
+      DoHandleEvent(False,IO);
+      tr.Commit;
+      SetDefaultResponseCode(IO);
+    except
+      TR.RollBack;
+      Raise;
+    end;
+  finally
+    IO.SetConn(Nil,Nil);
+    DoneSQLConnection(aConnection,Conn,Tr);
+  end;
+end;
+
+function TSQLDBRestDispatcher.GetConnectionName(IO: TRestIO): UTF8String;
+
+Var
+  N : UTF8String;
+  R : TSQLDBRestResource;
+begin
+  R:=IO.Resource;
+  N:='';
+  if (N='') then
+    N:=R.ConnectionName;
+  if (N='') and assigned(R.GetSchema) then
+    N:=R.GetSchema.ConnectionName;
+  if (N='') then
+    IO.GetVariable(Strings.ConnectionParam,N,[vsQuery]);
+  if (N='') and (rdoConnectionInURL in DispatchOptions) then
+    IO.GetVariable(Strings.ConnectionParam,N,[vsQuery]);
+  If Assigned(FOnGetConnectionName) then
+    FOnGetConnectionName(Self,IO.Request,R.ResourceName,N);
+  if (N='') then
+    N:=DefaultConnection;
+  Result:=N;
+end;
+
+function TSQLDBRestDispatcher.FindConnection(IO: TRestIO): TSQLDBRestConnection;
+
+Var
+  N : UTF8String;
+
+begin
+  N:=GetConnectionName(IO);
+  // If we have a name, look for it
+  if (N<>'') then
+    begin
+    Result:=Connections.FindConnection(N);
+    if Assigned(Result) and not (Result.Enabled) then
+      Result:=Nil;
+    end
+  else if Connections.Count=1 then
+    Result:=Connections[0]
+  else
+    Result:=Nil;
+end;
+
+function TSQLDBRestDispatcher.CreateConnectionList: TSQLDBRestConnectionList;
+begin
+  Result:=TSQLDBRestConnectionList.Create(TSQLDBRestConnection);
+
+end;
+
+function TSQLDBRestDispatcher.CreateSchemaList: TSQLDBRestSchemaList;
+begin
+  Result:=TSQLDBRestSchemaList.Create(TSQLDBRestSchemaRef);
+end;
+
+procedure TSQLDBRestDispatcher.DoHandleRequest(IO : TRestIO);
+
+var
+  ResourceName : UTF8String;
+  Operation : TRestOperation;
+  Resource : TSQLDBRestResource;
+  Connection : TSQLDBRestConnection;
+
+begin
+  Operation:=ExtractRestOperation(IO.Request);
+  if (Operation=roUnknown) then
+    CreateErrorContent(IO,400,'Invalid method')
+  else
+    begin
+    IO.SetOperation(Operation);
+    ResourceName:=ExtractRestResourceName(IO);
+    if (ResourceName='') then
+      CreateErrorContent(IO,404,'Invalid resource')
+    else
+      begin
+      Resource:=FindSpecialResource(IO,ResourceName);
+      If Resource=Nil then
+        Resource:=FindRestResource(ResourceName);
+      if Resource=Nil then
+        CreateErrorContent(IO,404,'Invalid resource')
+      else if Not (Operation in Resource.AllowedOperations) then
+        CreateErrorContent(IO,405,'Method not allowed')
+      else
+        begin
+        IO.SetResource(Resource);
+        Connection:=FindConnection(IO);
+        if Connection=Nil then
+          begin
+          if (rdoConnectionInURL in DispatchOptions) then
+            CreateErrorContent(IO,400,Format(SErrNoconnection,[GetConnectionName(IO)]))
+          else
+            CreateErrorContent(IO,500,Format(SErrNoconnection,[GetConnectionName(IO)]));
+          end
+        else if not AllowRestResource(IO) then
+          CreateErrorContent(IO,403,'Forbidden')
+        else
+          if Operation=roOptions then
+            HandleCORSRequest(Connection,IO)
+          else
+            HandleResourceRequest(Connection,IO);
+        end;
+      end;
+    end;
+end;
+
+procedure TSQLDBRestDispatcher.UnRegisterRoutes;
+
+  Procedure Un(Var a : THTTPRoute);
+
+  begin
+    if A=Nil then
+      exit;
+    HTTPRouter.DeleteRoute(A);
+    A:=Nil;
+  end;
+
+begin
+  Un(FListRoute);
+  Un(FItemRoute);
+end;
+
+procedure TSQLDBRestDispatcher.RegisterRoutes;
+begin
+  if (FListRoute<>Nil) then
+    UnRegisterRoutes;
+  DoRegisterRoutes;
+end;
+
+procedure TSQLDBRestDispatcher.HandleException(E : Exception; IO : TRestIO);
+
+  Function StripCR(S : String) : String;
+  begin
+    Result:=StringReplace(S,#13#10,' ',[rfReplaceAll]);
+    Result:=StringReplace(Result,#13,' ',[rfReplaceAll]);
+    Result:=StringReplace(Result,#10,' ',[rfReplaceAll]);
+  end;
+
+Var
+  Code : Integer;
+  Msg : String;
+
+begin
+  try
+    if Assigned(FOnException) then
+      FOnException(Self,IO.Request,IO.ResourceName,E);
+    if not IO.Response.ContentSent then
+      begin
+      Code:=0;
+      If E is ESQLDBRest then
+        begin
+        Code:=ESQLDBRest(E).ResponseCode;
+        Msg:=E.Message;
+        end;
+      if (Code=0) then
+        begin
+        Code:=500;
+        Msg:=Format(SErrUnexpectedException,[E.ClassName,E.Message]);
+        end;
+      IO.Response.Code:=Code;
+      IO.Response.CodeText:=StripCR(Msg);
+      if (IO.Response.Code=405) and Assigned(IO.Resource) then
+        IO.Response.Allow:=IO.Resource.GetHTTPAllow; // ([rmHead,rmOptions]) ?
+      IO.RESTOutput.CreateErrorContent(Code,Msg);
+      end;
+  except
+    on Ex : exception do
+     begin
+     IO.Response.Code:=500;
+     IO.Response.CodeText:=Format('Unexpected exception %s while handling original exception %s : "%s" (Original: "%s")',[Ex.ClassName,E.ClassName,Ex.Message,E.Message]);
+     end;
+  end;
+end;
+
+function TSQLDBRestDispatcher.AuthenticateRequest(IO: TRestIO; Delayed : Boolean): Boolean;
+
+Var
+  B : TRestBasicAuthenticator;
+  A : TRestAuthenticator;
+
+begin
+  A:=Nil;
+  B:=Nil;
+  If Assigned(FAuthenticator) then
+    A:=FAuthenticator
+  else If Assigned(FOnBAsicAuthentication) then
+    begin
+    B:=TRestBasicAuthenticator.Create(Self);
+    A:=B;
+    B.OnBasicAuthentication:=Self.OnBasicAuthentication;
+    end;
+  try
+    Result:=A=Nil;
+    if Not Result Then
+      begin
+      Result:=(A.NeedConnection<>Delayed);
+      If Not Result then
+        Result:=A.AuthenticateRequest(IO)
+      end;
+  finally
+    if Assigned(B) then
+      B.Free;
+  end;
+end;
+
+procedure TSQLDBRestDispatcher.Notification(AComponent: TComponent;
+  Operation: TOperation);
+
+begin
+  inherited Notification(AComponent, Operation);
+  if Operation=opRemove then
+    begin
+    if AComponent=FAuthenticator then
+      FAuthenticator:=Nil
+    end;
+end;
+
+procedure TSQLDBRestDispatcher.HandleRequest(aRequest: TRequest; aResponse: TResponse);
+
+Var IO : TRestIO;
+
+begin
+  aResponse.Code:=0; // Sentinel
+  IO:=CreateIO(aRequest,aResponse);
+  try
+    try
+      // Call initstreaming only here, so IO has set var callback.
+      // First output, then input
+      IO.RestOutput.InitStreaming;
+      IO.RestInput.InitStreaming;
+      if AuthenticateRequest(IO,False) then
+        DoHandleRequest(IO)
+    except
+      On E : Exception do
+        HandleException(E,IO);
+    end;
+  Finally
+    if Not (IO.Operation in [roOptions,roHEAD]) then
+      IO.RestOutput.FinalizeOutput;
+    aResponse.ContentStream.Position:=0;
+    aResponse.ContentLength:=aResponse.ContentStream.Size;
+    if not aResponse.ContentSent then
+      aResponse.SendContent;
+    IO.Free;
+  end;
+end;
+
+function TSQLDBRestDispatcher.ExposeDatabase(const aType, aHostName, aDatabaseName, aUserName, aPassword: String;
+  aTables: array of String; aMinFieldOpts: TRestFieldOptions): TSQLDBRestConnection;
+
+Var
+  L : TStringList;
+  S : String;
+
+begin
+  L:=TStringList.Create;
+  try
+    L.Capacity:=Length(aTables);
+    For S in aTables do
+      L.Add(S);
+    L.Sorted:=True;
+    Result:=ExposeDatabase(aType, aHostName, aDatabaseName, aUserName, aPassword,L, aMinFieldOpts);
+  finally
+    l.Free;
+  end;
+end;
+
+function TSQLDBRestDispatcher.ExposeDatabase(const aType, aHostName, aDatabaseName, aUserName, aPassword: String; aTables : TStrings = nil; aMinFieldOpts : TRestFieldOptions = []): TSQLDBRestConnection;
+
+
+begin
+  Result:=Connections.AddConnection(aType,aHostName,aDatabaseName,aUserName,aPassword);
+  ExposeConnection(Result,aTables,aMinFieldOpts);
+end;
+
+function TSQLDBRestDispatcher.ExposeConnection(aOwner: TComponent;
+  const aConnection: TSQLDBRestConnection; aTables: TStrings;
+  aMinFieldOpts: TRestFieldOptions): TSQLDBRestSchema;
+
+Var
+  Conn : TSQLConnection;
+  TR : TSQLTransaction;
+  S : TSQLDBRestSchema;
+
+begin
+  Conn:=GetSQLConnection(aConnection,TR);
+  S:=TSQLDBRestSchema.Create(aOwner);
+  S.Name:='Schema'+aConnection.Name;
+  S.PopulateResources(Conn,aTables,aMinFieldOpts);
+  if not (rdoConnectionInURL in DispatchOptions) then
+    S.ConnectionName:=aConnection.Name;
+  Schemas.AddSchema(S).Enabled:=true;
+  Result:=S;
+end;
+
+function TSQLDBRestDispatcher.ExposeConnection(
+  const aConnection: TSQLDBRestConnection; aTables: TStrings;
+  aMinFieldOpts: TRestFieldOptions): TSQLDBRestSchema;
+begin
+  Result:=ExposeConnection(Self,aConnection,aTables,aMinFieldOpts);
+end;
+
+{ TSchemaFreeNotifier }
+
+procedure TSchemaFreeNotifier.Notification(AComponent: TComponent; Operation: TOperation);
+begin
+  inherited Notification(AComponent, Operation);
+  if (Operation=opRemove) and Assigned(FRef) and (Fref.Schema=aComponent) then
+    Fref.Schema:=nil;
+end;
+
+
+{ TSQLDBRestSchemaRef }
+
+
+procedure TSQLDBRestSchemaRef.SetSchema(AValue: TSQLDBRestSchema);
+begin
+  if (FSchema=AValue) then Exit;
+  if Assigned(FSchema) then
+    FSchema.RemoveFreeNotification(FNotifier);
+  FSchema:=AValue;
+  if Assigned(FSchema) then
+    FSchema.FreeNotification(FNotifier);
+end;
+
+function TSQLDBRestSchemaRef.GetDisplayName: String;
+begin
+  if Assigned(FSchema) then
+    Result:=FSchema.Name
+  else
+    Result:=inherited GetDisplayName;
+end;
+
+constructor TSQLDBRestSchemaRef.Create(ACollection: TCollection);
+begin
+  inherited Create(ACollection);
+  FNotifier:=TSchemaFreeNotifier.Create(Nil);
+  TSchemaFreeNotifier(FNotifier).FRef:=Self;
+  FEnabled:=True;
+end;
+
+destructor TSQLDBRestSchemaRef.Destroy;
+begin
+  FreeAndNil(FNotifier);
+  inherited Destroy;
+end;
+
+procedure TSQLDBRestSchemaRef.Assign(Source: TPersistent);
+
+Var
+  R : TSQLDBRestSchemaRef;
+
+begin
+  if (Source is TSQLDBRestSchemaRef) then
+    begin
+    R:=Source as TSQLDBRestSchemaRef;
+    Schema:=R.Schema;
+    Enabled:=R.Enabled;
+    end
+  else
+    inherited Assign(Source);
+end;
+
+{ TSQLDBRestConnectionList }
+
+function TSQLDBRestConnectionList.GetConn(aIndex : integer): TSQLDBRestConnection;
+begin
+  Result:=TSQLDBRestConnection(Items[aIndex]);
+end;
+
+procedure TSQLDBRestConnectionList.SetConn(aIndex : integer; AValue: TSQLDBRestConnection);
+begin
+  Items[aIndex]:=aValue;
+end;
+
+function TSQLDBRestConnectionList.IndexOfConnection(const aName: string
+  ): Integer;
+begin
+  Result:=Count-1;
+  While (Result>=0) and not SameText(GetConn(Result).Name,aName) do
+    Dec(Result);
+end;
+
+function TSQLDBRestConnectionList.FindConnection(const aName: string): TSQLDBRestConnection;
+Var
+  Idx : Integer;
+
+begin
+  Idx:=IndexOfConnection(aName);
+  if Idx=-1 then
+    Result:=Nil
+  else
+    Result:=GetConn(Idx);
+end;
+
+function TSQLDBRestConnectionList.AddConnection(const AType, aHostName, aDatabaseName, aUserName, aPassword: UTF8String): TSQLDBRestConnection;
+
+Var
+  Idx : Integer;
+  N : String;
+begin
+  Result:=Add as TSQLDBRestConnection;
+  IDX:=Result.ID;
+  Repeat
+    N:='Connection'+IntToStr(IDX);
+    Inc(Idx);
+  Until IndexOfConnection(N)=-1;
+  Result.Name:=N;
+  Result.ConnectionType:=aType;
+  Result.HostName:=aHostName;
+  Result.DatabaseName:=aDatabaseName;
+  Result.UserName:=aUserName;
+  Result.Password:=aPassword;
+end;
+
+procedure TSQLDBRestConnectionList.SaveToFile(const aFileName: UTF8String);
+
+Var
+  F : TFileStream;
+
+begin
+  F:=TFileStream.Create(aFileName,fmCreate);
+  try
+    SaveToStream(F);
+  finally
+    F.Free;
+  end;
+end;
+
+procedure TSQLDBRestConnectionList.SaveToStream(const aStream: TStream);
+Var
+  D : TJSONData;
+  S : TJSONStringType;
+
+begin
+  D:=asJSON(JSONConnectionsRoot);
+  try
+    S:=D.FormatJSON();
+  finally
+    D.Free;
+  end;
+  aStream.WriteBuffer(S[1],Length(S)*SizeOf(TJSONCharType));
+end;
+
+function TSQLDBRestConnectionList.AsJSON(const aPropName: UTF8String): TJSONData;
+Var
+  S : TJSONStreamer;
+  A : TJSONArray;
+
+begin
+  S:=TJSONStreamer.Create(Nil);
+  try
+    A:=S.StreamCollection(Self);
+  finally
+    S.Free;
+  end;
+  if aPropName='' then
+    Result:=A
+  else
+    Result:=TJSONObject.Create([aPropName,A]);
+end;
+
+procedure TSQLDBRestConnectionList.LoadFromFile(const aFileName: UTF8String);
+Var
+  F : TFileStream;
+
+begin
+  F:=TFileStream.Create(aFileName,fmOpenRead or fmShareDenyWrite);
+  try
+    LoadFromStream(F);
+  finally
+    F.Free;
+  end;
+end;
+
+procedure TSQLDBRestConnectionList.LoadFromStream(const aStream: TStream);
+
+Var
+  D : TJSONData;
+
+begin
+  D:=GetJSON(aStream);
+  try
+    FromJSON(D,JSONConnectionsRoot);
+  finally
+    D.Free;
+  end;
+end;
+
+procedure TSQLDBRestConnectionList.FromJSON(aData: TJSONData; const aPropName: UTF8String);
+Var
+  A : TJSONArray;
+  D : TJSONDestreamer;
+
+begin
+  if (aPropName<>'') then
+    A:=(aData as TJSONObject).Arrays[aPropName]
+  else
+    A:=aData as TJSONArray;
+  D:=TJSONDestreamer.Create(Nil);
+  try
+    Clear;
+    D.JSONToCollection(A,Self);
+  finally
+    D.Free;
+  end;
+end;
+
+{ TSQLDBRestConnection }
+
+procedure TSQLDBRestConnection.SetParams(AValue: TStrings);
+begin
+  if FParams=AValue then Exit;
+  FParams.Assign(AValue);
+end;
+
+function TSQLDBRestConnection.GetDisplayName: string;
+begin
+  Result:=Name;
+end;
+
+procedure TSQLDBRestConnection.SetConnection(AValue: TSQLConnection);
+begin
+  if FConnection=AValue then Exit;
+  if Assigned(FConnection) then
+    FConnection.RemoveFreeNotification(FNotifier);
+  FConnection:=AValue;
+  if Assigned(FConnection) then
+    FConnection.FreeNotification(FNotifier);
+end;
+
+function TSQLDBRestConnection.GetName: UTF8String;
+begin
+  Result:=FName;
+  if (Result='') and Assigned(SingleConnection) then
+    Result:=SingleConnection.Name;
+  if (Result='') then
+    Result:='Connection'+IntToStr(ID);
+end;
+
+constructor TSQLDBRestConnection.Create(ACollection: TCollection);
+begin
+  inherited Create(ACollection);
+  FParams:=TStringList.Create;
+  FNotifier:=TConnectionFreeNotifier.Create(Nil);
+  TConnectionFreeNotifier(FNotifier).FRef:=Self;
+  FEnabled:=True;
+end;
+
+destructor TSQLDBRestConnection.Destroy;
+begin
+  TConnectionFreeNotifier(FNotifier).FRef:=Nil;
+  FreeAndNil(FNotifier);
+  FreeAndNil(FParams);
+  inherited Destroy;
+end;
+
+procedure TSQLDBRestConnection.Assign(Source: TPersistent);
+
+Var
+  C : TSQLDBRestConnection;
+
+begin
+  if (Source is TSQLDBRestConnection) then
+    begin
+    C:=Source as TSQLDBRestConnection;
+    Password:=C.Password;
+    UserName:=C.UserName;
+    CharSet :=C.CharSet;
+    HostName:=C.HostName;
+    Role:=C.Role;
+    DatabaseName:=C.DatabaseName;
+    ConnectionType:=C.ConnectionType;
+    Params.Assign(C.Params);
+    end
+  else
+    inherited Assign(Source);
+end;
+
+
+Procedure InitSQLDBRest;
+
+begin
+  TSQLDBRestDispatcher.SetIOClass(TRestIO);
+  TSQLDBRestDispatcher.SetDBHandlerClass(TSQLDBRestDBHandler);
+  TSQLDBRestResource.DefaultFieldListClass:=TSQLDBRestFieldList;
+  TSQLDBRestResource.DefaultFieldClass:=TSQLDBRestField;
+end;
+
+Initialization
+  InitSQLDBRest;
+end.
+

packages/fcl-web/src/restbridge/sqldbrestcds.pp

@@ -0,0 +1,320 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2019 by the Free Pascal development team
+
+    SQLDB REST CDS input/output
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit sqldbrestcds;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, DateUtils, db,fpjson, dom, XMLRead, XMLWrite,sqldbrestschema,sqldbrestio, sqldbrestbridge;
+
+Type
+
+  { TCDSInputStreamer }
+
+  TCDSInputStreamer = Class(TRestInputStreamer)
+  private
+    FXML: TXMLDocument;
+    FPacket : TDOMElement;
+    FROWData : TDOMElement;
+    FRow : TDOMElement;
+  Public
+    Destructor Destroy; override;
+    Class Function GetContentType: String; override;
+    Function SelectObject(aIndex : Integer) : Boolean; override;
+    function GetContentField(aName: UTF8string): TJSONData; override;
+    procedure InitStreaming; override;
+    Property XML : TXMLDocument Read FXML;
+    Property Packet : TDOMElement Read FPacket;
+    Property RowData : TDOMElement Read FRowData;
+    Property Row : TDOMElement Read FRow;
+  end;
+
+  { TCDSOutputStreamer }
+
+  TCDSOutputStreamer = Class(TRestOutputStreamer)
+  Private
+    FXML: TXMLDocument;
+    FDataPacket : TDOMElement;
+    FMetaData : TDOMElement;
+    FRow : TDOMElement;
+    FRowData: TDOMElement;
+  Protected
+    Procedure SetOutputOptions(AValue: TRestOutputOptions); override;
+  Public
+    procedure EndData; override;
+    procedure EndRow; override;
+    procedure FinalizeOutput; override;
+    procedure StartData; override;
+    procedure StartRow; override;
+    // Return Nil for null field.
+    procedure WriteField(aPair: TRestFieldPair); override;
+    procedure WriteMetadata(aFieldList: TRestFieldPairArray); override;
+    Procedure CreateErrorContent(aCode : Integer; Const aMessage: String); override;
+    Property XML : TXMLDocument Read FXML;
+    Property RowData : TDOMelement Read FRowData;
+    Property Row : TDOMelement Read FRow;
+    Property Metadata : TDOMelement Read FMetadata;
+  Public
+    Destructor Destroy; override;
+    Class Function GetContentType: String; override;
+    procedure InitStreaming; override;
+  end;
+
+implementation
+
+uses sqldbrestconst;
+
+
+
+Const
+  DateTimeFmt = 'yyyymmddThh:nn:sszzz';
+
+
+Const
+  XMLPropTypeNames : Array [TRestFieldType] of UnicodeString = (
+    'Unknown' {rftUnknown},
+    'i4' {rftInteger},
+    'i8' {rftLargeInt},
+    'r8' {rftFloat},
+    'dateTime' {rftDate},
+    'dateTime' {rftTime},
+    'dateTime' {rftDateTime},
+    'string' {rftString},
+    'boolean' {rftBoolean},
+    'bin.hex:Binary' {rftBlob}
+  );
+
+{ TCDSInputStreamer }
+
+destructor TCDSInputStreamer.Destroy;
+begin
+  FreeAndNil(FXML);
+  inherited Destroy;
+end;
+
+class function TCDSInputStreamer.GetContentType: String;
+begin
+  Result:='text/xml';
+end;
+
+function TCDSInputStreamer.SelectObject(aIndex: Integer): Boolean;
+
+Var
+  N : TDomNode;
+  NN : UnicodeString;
+begin
+  Result:=False;
+  NN:='ROW';
+  N:=FRowData.FindNode(NN);
+  if Not (Assigned(N) and (N is TDOMelement)) then
+    raise ESQLDBRest.CreateFmt(400, SErrInvalidCDSMissingElement,[NN]);
+  While (aIndex>0) and (N<>Nil) and (N.NodeName<>NN) and (N.NodeType<>ELEMENT_NODE) do
+    begin
+    N:=N.NextSibling;
+    Dec(aIndex);
+    end;
+  Result:=(aIndex=0) and (N<>Nil);
+  If Result then
+    FRow:=N as TDomElement
+  else
+    FRow:=Nil;
+end;
+
+
+function TCDSInputStreamer.GetContentField(aName: UTF8string): TJSONData;
+
+Var
+  NN : UnicodeString;
+
+begin
+  NN:=UTF8Decode(aName);
+  if Assigned(FRow) and FRow.hasAttribute(NN) then
+    Result:=TJSONString.Create(FRow.AttribStrings[NN])
+  else
+    Result:=Nil;
+end;
+
+procedure TCDSInputStreamer.InitStreaming;
+
+Var
+  Msg : String;
+  N : TDomNode;
+
+begin
+  FreeAndNil(FXML);
+  if Stream.Size<=0 then
+    exit;
+  try
+    ReadXMLFile(FXML,Stream);
+  except
+    On E : Exception do
+      begin
+      Msg:=E.Message;
+      FXML:=Nil;
+      end;
+  end;
+  if (FXML=Nil)  then
+    raise ESQLDBRest.CreateFmt(400, SErrInvalidXMLInput, [Msg]);
+  FPacket:=FXML.DocumentElement;
+  if (FPacket=Nil)  then
+    raise ESQLDBRest.CreateFmt(400, SErrInvalidXMLInput, [SErrMissingDocumentRoot]);
+  if (FPacket.NodeName<>'DATAPACKET') then
+    Raise ESQLDBRest.CreateFmt(400,SErrInvalidCDSMissingElement,['DATAPACKET']);
+  N:=FPacket.FindNode('ROWDATA');
+  if Not (Assigned(N) and (N is TDOMelement)) then
+    Raise ESQLDBRest.CreateFmt(400,SErrInvalidCDSMissingElement,[ROWDATA]);
+  FRowData:=(N as TDOMelement);
+end;
+
+{ TCDSOutputStreamer }
+
+procedure TCDSOutputStreamer.SetOutputOptions(AValue: TRestOutputOptions);
+begin
+  Include(AValue,ooMetadata); // We always need metadata
+  inherited SetOutputOptions(AValue);
+end;
+
+procedure TCDSOutputStreamer.EndData;
+begin
+  FRowData:=Nil;
+end;
+
+procedure TCDSOutputStreamer.EndRow;
+begin
+  FRow:=Nil;
+end;
+
+procedure TCDSOutputStreamer.FinalizeOutput;
+
+begin
+  xmlwrite.WriteXML(FXML,Stream);
+  FreeAndNil(FXML);
+end;
+
+procedure TCDSOutputStreamer.StartData;
+
+begin
+  // Do nothing
+end;
+
+procedure TCDSOutputStreamer.StartRow;
+begin
+  if (FRow<>Nil) then
+    Raise ESQLDBRest.Create(500,SErrDoubleRowStart);
+  FRow:=FXML.CreateElement('ROW');
+  FRowData.AppendChild(FRow);
+end;
+
+procedure TCDSOutputStreamer.WriteField(aPair: TRestFieldPair);
+
+Var
+  N : UTF8String;
+  S : UTF8String;
+  F : TField;
+
+begin
+  N:=aPair.RestField.PublicName;
+  if FRow=Nil then
+    Raise ESQLDBRest.CreateFmt(500,SErrFieldWithoutRow,[N]);
+  F:=aPair.DBField;
+  If (aPair.RestField.FieldType=rftUnknown) then
+    raise ESQLDBRest.CreateFmt(500,SErrUnsupportedRestFieldType, [N]);
+  If (F.IsNull) then
+    Exit;
+  if (aPair.RestField.FieldType in [rftDate,rftTime,rftDateTime]) then
+    S:=FormatDateTime(DateTimeFmt,F.AsDateTime)
+  else
+    S:=FieldToString(aPair.RestField.FieldType,F);
+  FRow[UTF8Decode(N)]:=UTF8Decode(S);
+end;
+
+procedure TCDSOutputStreamer.WriteMetadata(aFieldList: TRestFieldPairArray);
+
+Var
+  FL,F : TDOMElement;
+  P : TREstFieldPair;
+  S,ST : UnicodeString;
+  ml : Integer;
+
+begin
+  FL:=FXML.CreateElement('FIELDS');
+  FMetaData.AppendChild(FL);
+  For P in aFieldList do
+    begin
+    S:=XMLPropTypeNames[P.RestField.FieldType];
+    if (S<>'') then
+      begin
+      ST:='';
+      if P.RestField.PublicName='ID' then
+        ST:='autoinc';
+      F:=FXML.CreateElement('FIELD');
+      F['attrname']:=Utf8Decode(P.RestField.PublicName);
+      F['fieldtype']:=S;
+      if P.RestField.FieldType=rftString then
+         begin
+         ML:=P.RestField.MaxLen;
+         if ML=0 then
+           ML:=255;
+         F['WIDTH']:=Utf8Decode(IntToStr(P.RestField.MaxLen));
+         end;
+      if (ST<>'') then
+        F['subtype']:=ST;
+      FL.AppendChild(F);
+      end;
+    end;
+end;
+
+class function TCDSOutputStreamer.GetContentType: String;
+begin
+  Result:='text/xml';
+end;
+
+procedure TCDSOutputStreamer.CreateErrorContent(aCode: Integer; const aMessage: String);
+
+Var
+  ErrorObj : TDomElement;
+
+begin
+  ErrorObj:=FXML.CreateElement(UTF8Decode(GetString(rpErrorRoot)));
+  ErrorObj['code']:=UTF8Decode(IntToStr(aCode));
+  ErrorObj['message']:=UTF8Decode(aMessage);
+  FDataPacket.AppendChild(ErrorObj);
+end;
+
+destructor TCDSOutputStreamer.Destroy;
+begin
+  FreeAndNil(FXML);
+  inherited Destroy;
+end;
+
+procedure TCDSOutputStreamer.InitStreaming;
+begin
+  FXML:=TXMLDocument.Create;
+  FDataPacket:=FXML.CreateElement('DATAPACKET');
+  FXML.AppendChild(FDataPacket);
+  FDataPacket['Version']:='2.0';
+  FMetaData:=FXML.CreateElement('METADATA');
+  FDataPacket.AppendChild(FMetaData);
+  FRowData:=FXML.CreateElement('ROWDATA');
+  FDataPacket.AppendChild(FRowData);
+end;
+
+Initialization
+  TCDSInputStreamer.RegisterStreamer('cds');
+  TCDSOutputStreamer.RegisterStreamer('cds');
+end.
+

packages/fcl-web/src/restbridge/sqldbrestconst.pp

@@ -0,0 +1,57 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2019 by the Free Pascal development team
+
+    SQLDB REST bridge constants.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit sqldbrestconst;
+
+{$mode objfpc}{$H+}
+
+interface
+
+Resourcestring
+  SErrNoconnection = 'Could not determine connection for resource "%s"';
+  SErrUnexpectedException = 'An unexpected exception %s occurred with message: %s';
+  SErrFieldWithoutRow = 'Attempt to write field %s without active row!';
+  SErrUnsupportedRestFieldType = 'Unsupported REST field type : %s';
+  SErrDoubleRowStart = 'Starting row within active row';
+  SErrMissingParameter = 'No value provided for parameter: "%s"';
+  SErrInvalidParam = 'Invalid value for parameter: "%s"';
+  SErrFilterParamNotFound = 'Filter parameter for field "%s" not found.';
+  SErrResourceNameEmpty = 'Resource Public name is not allowed to be empty.';
+  SErrDuplicateResource = 'Duplicate resource name : %s';
+  SErrUnknownStatement = 'Unknown kind of statement : %d';
+  SErrRegisterUnknownStreamerClass = 'Registering streamer of unknown class: %s';
+  SErrUnRegisterUnknownStreamerClass = 'Unregistering streamer of unknown class: %s';
+  SErrLimitNotSupported = 'Limit not supported by database backend';
+  SErrInvalidSortField = 'Field "%s" cannot be sorted on';
+  SErrInvalidSortDescField = 'Field "%s" cannot be sorted DESC';
+  SErrInvalidBooleanForField = 'Invalid boolean value for NULL filter on field "%s"';
+  SErrNoKeyParam = 'No key parameter specified';
+  SErrUnknownOrUnSupportedFormat = 'Unknown or unsupported streaming format: %s';
+  SUnauthorized = 'Unauthorized';
+  SErrInvalidXMLInputMissingElement = 'Invalid XML input: missing %s element ';
+  SErrInvalidXMLInput = 'Invalid XML input: %s';
+  SErrMissingDocumentRoot = 'Missing document root';
+  SErrInvalidCDSMissingElement = 'Invalid CDS Data packet: missing %s element';
+  SErrNoResourceDataFound = 'Failed to find resource data in input';
+
+Const
+  DefaultAuthenticationRealm = 'REST API Server';
+  ISODateTimeFormat = 'YYYY"-"mm"-"dd"T"hh":"nn":"ss"';
+  ISODateFormat = ISODateTimeFormat;
+  ISOTimeFormat = '"0000-00-00T"hh":"nn":"ss"';
+
+implementation
+
+end.
+

packages/fcl-web/src/restbridge/sqldbrestcsv.pp

@@ -0,0 +1,210 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2019 by the Free Pascal development team
+
+    SQLDB REST CSV input/output
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit sqldbrestcsv;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, sqldbrestio, fpjson, sqldbrestschema, csvreadwrite;
+
+Type
+  { TCSVInputStreamer }
+
+  TCSVInputStreamer = Class(TRestInputStreamer)
+  private
+    FCSV: TCSVParser;
+    FValues,
+    FFields : TStrings;
+  Protected
+    Property CSV : TCSVParser Read FCSV;
+  Public
+    Destructor Destroy; override;
+    Function SelectObject(aIndex : Integer) : Boolean; override;
+    function GetContentField(aName: UTF8string): TJSONData; override;
+    procedure InitStreaming; override;
+  end;
+
+  { TCSVOutputStreamer }
+  TCSVOutputStreamer = Class(TRestOutputStreamer)
+  Private
+    FCSV : TCSVBuilder;
+    FField : integer;
+    FRow : Integer;
+  Public
+    procedure EndData; override;
+    procedure EndRow; override;
+    procedure FinalizeOutput; override;
+    procedure StartData; override;
+    procedure StartRow; override;
+    // Return Nil for null field.
+    procedure WriteField(aPair: TRestFieldPair); override;
+    procedure WriteMetadata(aFieldList: TRestFieldPairArray); override;
+    Procedure CreateErrorContent(aCode : Integer; Const aMessage: String); override;
+    Property CSV : TCSVBuilder Read FCSV;
+  Public
+    Destructor Destroy; override;
+    Class Function GetContentType: String; override;
+    procedure InitStreaming; override;
+  end;
+
+implementation
+
+uses DateUtils;
+
+{ TCSVInputStreamer }
+
+procedure TCSVInputStreamer.InitStreaming;
+
+begin
+  FreeAndNil(FCSV);
+  FreeAndNil(FFields);
+  FCSV:=TCSVParser.Create;
+  FCSV.SetSource(Stream);
+  FCSV.QuoteChar:='"';
+  FCSV.Delimiter:=',';
+  FCSV.LineEnding:=LineEnding;//
+  FFields:=TStringList.Create;
+  FValues:=TStringList.Create;
+  While FCSV.ParseNextCell and (FCSV.CurrentRow=0) do
+    FFields.Add(FCSV.CurrentCellText);
+end;
+
+destructor TCSVInputStreamer.Destroy;
+begin
+  FreeAndNil(FCSV);
+  FreeAndNil(FValues);
+  FreeAndNil(FFields);
+  inherited Destroy;
+end;
+
+function TCSVInputStreamer.SelectObject(aIndex: Integer): Boolean;
+
+begin
+  Result:=(aIndex=0) and (FCSV<>Nil) and (FCSV.CurrentRow=1);
+  if Not Result then
+    exit;
+  Repeat
+   // We are on the first cell
+   FValues.Add(FCSV.CurrentCellText);
+  until Not (FCSV.ParseNextCell) or (FCSV.CurrentRow=2);
+end;
+
+function TCSVInputStreamer.GetContentField(aName: UTF8string): TJSONData;
+
+Var
+  Idx : Integer;
+
+begin
+  Idx:=FFields.IndexOf(aName);
+  if (Idx>=0) and (Idx<FValues.Count) then
+    Result:=TJSONString.Create(FValues[Idx])
+  else
+    Result:=nil;
+end;
+
+{ TCSVOutputStreamer }
+
+
+procedure TCSVOutputStreamer.EndData;
+begin
+  FRow:=0;
+end;
+
+procedure TCSVOutputStreamer.EndRow;
+begin
+  if FField=0 then exit;
+  inc(FRow);
+  FCSV.AppendRow;
+  FField:=0;
+end;
+
+procedure TCSVOutputStreamer.FinalizeOutput;
+
+
+begin
+  // Nothing needs to be done.
+  FreeAndNil(FCSV);
+end;
+
+procedure TCSVOutputStreamer.StartData;
+begin
+  FRow:=0;
+end;
+
+procedure TCSVOutputStreamer.StartRow;
+begin
+  Inc(FRow);
+end;
+
+procedure TCSVOutputStreamer.WriteField(aPair: TRestFieldPair);
+
+Var
+  S : UTF8String;
+
+begin
+  S:=FieldToString(aPair.RestField.FieldType,aPair.DBField);
+  FCSV.AppendCell(S);
+  Inc(FField);
+end;
+
+procedure TCSVOutputStreamer.WriteMetadata(aFieldList: TRestFieldPairArray);
+
+Var
+  P : TREstFieldPair;
+
+begin
+  For P in aFieldList do
+    FCSV.AppendCell(P.RestField.PublicName);
+  FCSV.AppendRow;
+end;
+
+Class function TCSVOutputStreamer.GetContentType: String;
+begin
+  Result:='text/csv';
+end;
+
+procedure TCSVOutputStreamer.CreateErrorContent(aCode: Integer; const aMessage: String);
+
+Var
+  S : String;
+
+begin
+  S:=Format('<html><title>Error %d: %s</title>',[aCode,aMessage]);
+  S:=S+Format('<body><h1>Error %d : %s</h1></body></html>',[aCode,aMessage]);
+  Stream.WriteBuffer(S[1],Length(S));
+end;
+
+destructor TCSVOutputStreamer.Destroy;
+begin
+  FreeAndNil(FCSV);
+  inherited Destroy;
+end;
+
+procedure TCSVOutputStreamer.InitStreaming;
+begin
+  FCSV:=TCSVBuilder.Create;
+  FCSV.SetOutput(Stream);
+  FCSV.QuoteChar:='"';
+  FCSV.Delimiter:=',';
+  FCSV.QuoteOuterWhitespace:=True;
+end;
+
+initialization
+  TCSVInputStreamer.RegisterStreamer('CSV');
+  TCSVOutputStreamer.RegisterStreamer('CSV');
+end.
+

packages/fcl-web/src/restbridge/sqldbrestdata.pp

@@ -0,0 +1,880 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2019 by the Free Pascal development team
+
+    SQLDB REST data manipulation routines.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit sqldbrestdata;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, sqldb, db, fpjson, sqldbrestio, sqldbrestschema;
+
+Type
+  TSQLQueryClass = Class of TSQLQuery;
+
+  TRestFilterPair = Record
+    Field : TSQLDBRestField;
+    Operation : TRestFieldFilter;
+    ValueParam : TParam;
+    Value : String;
+  end;
+  TRestFilterPairArray = Array of TRestFilterPair;
+
+  { TSQLDBRestDBHandler }
+
+  TSQLDBRestDBHandler = Class(TComponent)
+  private
+    FDeriveResourceFromDataset: Boolean;
+    FEmulateOffsetLimit: Boolean;
+    FEnforceLimit: Int64;
+    FExternalDataset: TDataset;
+    FPostParams: TParams;
+    FQueryClass: TSQLQueryClass;
+    FRestIO: TRestIO;
+    FStrings : TRestStringsConfig;
+    FResource : TSQLDBRestResource;
+    FOwnsResource : Boolean;
+    procedure SetExternalDataset(AValue: TDataset);
+    function StreamRecord(O: TRestOutputStreamer; D: TDataset; FieldList: TRestFieldPairArray): Boolean;
+  Protected
+    procedure CreateResourceFromDataset(D: TDataset); virtual;
+    procedure DoNotFound; virtual;
+    procedure SetPostParams(aParams: TParams; Old : TFields = Nil);virtual;
+    procedure InsertNewRecord; virtual;
+    procedure UpdateExistingRecord(OldData: TDataset); virtual;
+    Procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+    function SpecialResource: Boolean; virtual;
+    function GetGeneratorValue(const aGeneratorName: String): Int64; virtual;
+    function GetSpecialDatasetForResource(aFieldList: TRestFieldPairArray): TDataset; virtual;
+    function FindFieldForParam(aOperation: TRestOperation; P: TParam): TSQLDBRestField; virtual;
+    function BuildFieldList(ForceAll : Boolean): TRestFieldPairArray; virtual;
+    function CreateQuery(aSQL: String): TSQLQuery; virtual;
+    procedure FillParams(aOperation: TRestOperation; aQuery: TSQLQuery; FilteredFields: TRestFilterPairArray); virtual;
+    function GetDatasetForResource(aFieldList: TRestFieldPairArray; Singleton : Boolean): TDataset; virtual;
+    function GetOrderByFieldArray: TRestFieldOrderPairArray;
+    function GetOrderBy: UTF8String;virtual;
+    function GetIDWhere(Out FilteredFields : TRestFilterPairArray): UTF8String; virtual;
+    function GetWhere(Out FilteredFields : TRestFilterPairArray): UTF8String; virtual;
+    function GetLimit: UTF8String;
+    // Handle 4 basic operations
+    procedure DoHandleGet;virtual;
+    procedure DoHandleDelete;virtual;
+    procedure DoHandlePost;virtual;
+    procedure DoHandlePut; virtual;
+    // Parameters used when executing update SQLs. Used to get values for return dataset params.
+    Property PostParams : TParams Read FPostParams;
+  Public
+    Destructor Destroy; override;
+    // Get limi
+    Function GetLimitOffset(out aLimit, aOffset: Int64) : Boolean; virtual;
+    Procedure Init(aIO: TRestIO; aStrings : TRestStringsConfig;AQueryClass : TSQLQueryClass); virtual;
+    Procedure ExecuteOperation;
+    Function StreamDataset(O: TRestOutputStreamer; D: TDataset; FieldList: TRestFieldPairArray) : Int64;
+    procedure SetParamFromData(P: TParam; F: TSQLDBRestField; D: TJSONData); virtual;
+    function GetDataForParam(P: TParam; F: TSQLDBRestField; Sources : TVariableSources = AllVariableSources): TJSONData; virtual;
+    Function GetString(aString : TRestStringProperty) : UTF8String;
+    Property IO : TRestIO Read FRestIO;
+    Property Strings : TRestStringsConfig Read FStrings;
+    Property QueryClass : TSQLQueryClass Read FQueryClass;
+    Property EnforceLimit : Int64 Read FEnforceLimit Write FEnforceLimit;
+    Property ExternalDataset : TDataset Read FExternalDataset Write SetExternalDataset;
+    Property EmulateOffsetLimit : Boolean Read FEmulateOffsetLimit Write FEmulateOffsetLimit;
+    Property DeriveResourceFromDataset : Boolean Read FDeriveResourceFromDataset Write FDeriveResourceFromDataset;
+  end;
+  TSQLDBRestDBHandlerClass = class of TSQLDBRestDBHandler;
+
+
+implementation
+
+uses strutils, dateutils, base64, sqldbrestconst;
+
+
+Const
+  FilterParamPrefix : Array [TRestFieldFilter] of string = ('eq_','lt_','gt_','lte_','gte_','');
+  FilterOps : Array [TRestFieldFilter] of string = ('=','<','>','<=','>=','IS NULL');
+
+{ TSQLDBRestDBHandler }
+
+
+procedure TSQLDBRestDBHandler.Init(aIO: TRestIO; aStrings: TRestStringsConfig; AQueryClass: TSQLQueryClass);
+begin
+  FRestIO:=aIO;
+  FQueryClass:=aQueryClass;
+  FStrings:=aStrings;
+end;
+
+procedure TSQLDBRestDBHandler.ExecuteOperation;
+
+begin
+  if Not DeriveResourceFromDataset then
+    FResource:=IO.Resource;
+  Case IO.Operation of
+    roGet : DoHandleGet;
+    roPut : DoHandlePut;
+    roPost : DoHandlePost;
+    roDelete : DoHandleDelete;
+  end;
+end;
+
+function TSQLDBRestDBHandler.GetString(aString: TRestStringProperty): UTF8String;
+begin
+  if Assigned(FStrings) then
+    Result:=FStrings.GetRestString(aString)
+  else
+    Result:=TRestStringsConfig.GetDefaultString(aString);
+end;
+
+
+function TSQLDBRestDBHandler.GetIDWhere(out FilteredFields: TRestFilterPairArray): UTF8String;
+
+Var
+  Qry : UTF8String;
+  L : TSQLDBRestFieldArray;
+  F: TSQLDBRestField;
+  I : Integer;
+
+begin
+  FilteredFields:=Default(TRestFilterPairArray);
+  Result:='';
+  if (IO.GetVariable('ID',Qry,[vsQuery,vsRoute,vsHeader])=vsNone) or (Qry='') then
+    if not Assigned(PostParams) then
+      raise ESQLDBRest.Create(400,SErrNoKeyParam);
+  L:=FResource.GetFieldArray(flWhereKey);
+  SetLength(FilteredFields,Length(L));
+  for I:=0 to Length(L)-1 do
+    begin
+    F:=L[i];
+    FilteredFields[I].Field:=F;
+    FilteredFields[I].Operation:=rfEqual;
+    // If we have postparams, it means we're building a dataset for return data.
+    // So check for actual DB value there
+    if Assigned(PostParams) then
+      FilteredFields[I].ValueParam:=PostParams.FindParam(F.FieldName);
+    if (FilteredFields[I].ValueParam=nil) then
+      FilteredFields[I].Value:=ExtractWord(1,Qry,['|']);
+    If (Result<>'') then
+      Result:=Result+' and ';
+    Result:='('+F.FieldName+' = :'+FilterParamPrefix[rfEqual]+F.FieldName+')';
+    end;
+end;
+
+function TSQLDBRestDBHandler.GetWhere(Out FilteredFields : TRestFilterPairArray): UTF8String;
+
+Const
+  MaxFilterCount = 1+ Ord(High(TRestFieldFilter)) - Ord(Low(TRestFieldFilter));
+
+Var
+  Qry : UTF8String;
+  L : TSQLDBRestFieldArray;
+  RF : TSQLDBRestField;
+  fo : TRestFieldFilter;
+  aLen : integer;
+
+begin
+  FilteredFields:=Default(TRestFilterPairArray);
+  Result:='';
+  L:=FResource.GetFieldArray(flFilter);
+  SetLength(FilteredFields,Length(L)*MaxFilterCount);
+  aLen:=0;
+  for RF in L do
+    for FO in RF.Filters do
+      if IO.GetFilterVariable(RF.PublicName,FO,Qry)<>vsNone then
+        begin
+        FilteredFields[aLen].Field:=RF;
+        FilteredFields[aLen].Operation:=FO;
+        FilteredFields[aLen].Value:=Qry;
+        Inc(aLen);
+        If (Result<>'') then Result:=Result+' AND ';
+        if FO<>rfNull then
+          Result:=Result+Format('(%s %s :%s%s)',[RF.FieldName,FilterOps[FO],FilterParamPrefix[FO],RF.FieldName])
+        else
+          Case IO.StrToNullBoolean(Qry,True) of
+            nbTrue : Result:=Result+Format('(%s IS NULL)',[RF.FieldName]);
+            nbFalse : Result:=Result+Format('(%s IS NOT NULL)',[RF.FieldName]);
+            nbNone :  Raise ESQLDBRest.CreateFmt(400,SErrInvalidBooleanForField,[RF.PublicName])
+          end;
+        end;
+  SetLength(FilteredFields,aLen);
+end;
+
+function TSQLDBRestDBHandler.GetOrderByFieldArray : TRestFieldOrderPairArray;
+
+  Procedure AddField(Idx : Integer; F : TSQLDBRestField; aDesc : boolean);
+
+  begin
+    Result[Idx].RestField:=F;
+    Result[Idx].Desc:=aDesc;
+  end;
+
+Var
+  L : TSQLDBRestFieldArray;
+  I,J,aLen : Integer;
+  F : TSQLDBRestField;
+  V,FN : UTF8String;
+  Desc : Boolean;
+
+begin
+  Result:=Default(TRestFieldOrderPairArray);
+  if IO.GetVariable(GetString(rpOrderBy),V,[vsQuery])=vsNone then
+    begin
+    L:=FResource.GetFieldArray(flWhereKey);
+    SetLength(Result,Length(L));
+    I:=0;
+    For F in L do
+      begin
+      AddField(I,F,False);
+      Inc(I);
+      end
+    end
+  else
+    begin
+    L:=FResource.GetFieldArray(flOrderBy);
+    aLen:=WordCount(V,[',']);
+    SetLength(Result,aLen);
+    For I:=1 to WordCount(V,[',']) do
+      begin
+      FN:=ExtractWord(I,V,[',']);
+      Desc:=SameText(ExtractWord(2,FN,[' ']),'desc');
+      FN:=ExtractWord(1,FN,[' ']);
+      J:=Length(L)-1;
+      While (J>=0) and Not SameText(L[J].PublicName,FN) do
+        Dec(J);
+      if J<0 then
+        Raise ESQLDBRest.CreateFmt(400,SErrInvalidSortField,[FN]);
+      F:=L[J];
+      if Desc then
+        if not (foOrderByDesc in F.Options) then
+          Raise ESQLDBRest.CreateFmt(400,SErrInvalidSortDescField,[FN]);
+      AddField(I-1,F,Desc)
+      end;
+    end;
+end;
+
+function TSQLDBRestDBHandler.GetOrderBy: UTF8String;
+
+Const
+  AscDesc : Array[Boolean] of string = ('ASC','DESC');
+
+Var
+  L : TRestFieldOrderPairArray;
+  P : TRestFieldOrderPair;
+
+begin
+  Result:='';
+  L:=GetOrderByFieldArray;
+  For P in L do
+    begin
+    if Result<>'' then
+      Result:=Result+', ';
+    Result:=Result+P.RestField.FieldName+' '+AscDesc[P.Desc];
+    end;
+end;
+
+function TSQLDBRestDBHandler.CreateQuery(aSQL: String): TSQLQuery;
+
+begin
+  Result:=FQueryClass.Create(Self);
+  Result.DataBase:=IO.Connection;
+  Result.Transaction:=IO.Transaction;
+  Result.SQL.Text:=aSQL;
+end;
+
+function TSQLDBRestDBHandler.BuildFieldList(ForceAll : Boolean): TRestFieldPairArray;
+
+Var
+  L : TSQLDBRestFieldArray;
+  F : TSQLDBRestField;
+  aCount : Integer;
+  Fi,Fe : TStrings;
+
+  Function ML(N : String) : TStrings;
+  Var
+    V : UTF8String;
+  begin
+    Result:=Nil;
+    if ForceAll then
+      exit;
+    IO.GetVariable(N,V);
+    if (V<>'') then
+      begin
+      Result:=TStringList.Create;
+      Result.StrictDelimiter:=True;
+      Result.CommaText:=V;
+      end;
+  end;
+
+  Function IsIncluded(F : TSQLDBRestField) : Boolean;
+  begin
+    Result:=(FI=Nil) or (FI.IndexOf(F.PublicName)<>-1)
+  end;
+
+  Function IsExcluded(F : TSQLDBRestField) : Boolean;
+  begin
+    Result:=(FE<>Nil) and (FE.IndexOf(F.PublicName)<>-1)
+  end;
+
+begin
+  Result:=Default(TRestFieldPairArray);
+  if Not Assigned(FResource) then
+    exit;
+  FE:=Nil;
+  FI:=ML(GetString(rpFieldList));
+  try
+    FE:=ML(GetString(rpExcludeFieldList));
+    L:=FResource.GetFieldArray(flSelect);
+    SetLength(Result,Length(L));
+    aCount:=0;
+    For F in L do
+      if IsIncluded(F) and not IsExcluded(F) then
+        begin
+        Result[aCount].RestField:=F;
+        Result[aCount].DBField:=Nil;
+        Inc(aCount);
+        end;
+     SetLength(Result,aCount);
+  finally
+    FI.Free;
+    FE.Free;
+  end;
+end;
+
+Function TSQLDBRestDBHandler.GetDataForParam(P : TParam; F : TSQLDBRestField; Sources : TVariableSources = AllVariableSources) : TJSONData;
+
+Var
+  vs : TVariableSource;
+  S,N : UTF8String;
+
+begin
+  Result:=Nil;
+  if Assigned(F) then
+    begin
+    N:=F.PublicName;
+    vs:=IO.GetVariable(N,S,Sources);
+    if (vs<>vsNone) then
+      Result:=TJSONString.Create(S)
+    else if (vsContent in Sources) then
+      Result:=IO.RESTInput.GetContentField(N);
+    end;
+  If (Result=Nil) then
+    begin
+    N:=P.Name;
+    if N='ID_' then
+      N:='ID';
+    vs:=IO.GetVariable(N,S);
+    if (vs<>vsNone) then
+      Result:=TJSONString.Create(S)
+    else if (vsContent in Sources) then
+      Result:=IO.RESTInput.GetContentField(N)
+    end;
+end;
+
+Procedure TSQLDBRestDBHandler.SetParamFromData(P : TParam; F : TSQLDBRestField; D : TJSONData);
+
+begin
+  if not Assigned(D) then
+    P.Clear
+  else if Assigned(F) then
+    Case F.FieldType of
+      rftInteger : P.AsInteger:=D.AsInteger;
+      rftLargeInt : P.AsLargeInt:=D.AsInt64;
+      rftFloat : P.AsFloat:=D.AsFloat;
+      rftDate : P.AsDateTime:=ScanDateTime(GetString(rpDateFormat),D.AsString);
+      rftTime : P.AsDateTime:=ScanDateTime(GetString(rpTimeFormat),D.AsString);
+      rftDateTime : P.AsDateTime:=ScanDateTime(GetString(rpDateTimeFormat),D.AsString);
+      rftString : P.AsString:=D.AsString;
+      rftBoolean : P.AsBoolean:=D.AsBoolean;
+      rftBlob :
+{$IFNDEF VER3_0}
+         P.AsBlob:=BytesOf(DecodeStringBase64(D.AsString));
+{$ELSE}
+         P.AsBlob:=DecodeStringBase64(D.AsString);
+{$ENDIF}
+    else
+      P.AsString:=D.AsString;
+    end
+  else
+    P.AsString:=D.AsString;
+end;
+
+Function TSQLDBRestDBHandler.FindFieldForParam(aOperation : TRestOperation; P : TParam) : TSQLDBRestField;
+
+Var
+  N : UTF8String;
+  A : TSQLDBRestFieldArray;
+
+begin
+  Result:=Nil;
+  N:=P.Name;
+  if (N='ID_') then
+    begin
+    A:=FResource.GetFieldArray(flWhereKey);
+    if (Length(A)=1) then
+      Result:=A[0];
+    end
+  else
+    Result:=FResource.Fields.FindByFieldName(N);
+end;
+
+procedure TSQLDBRestDBHandler.FillParams(aOperation : TRestOperation; aQuery: TSQLQuery;FilteredFields : TRestFilterPairArray);
+
+Var
+  I : Integer;
+  P : TParam;
+  D : TJSONData;
+  F : TSQLDBRestField;
+  FF : TRestFilterPair;
+  Sources : TVariableSources;
+
+
+begin
+  // Fill known params
+  for FF in FilteredFields do
+    begin
+    F:=FF.Field;
+    if FF.Operation<>rfNull then
+      begin
+      P:=aQuery.Params.FindParam(FilterParamPrefix[FF.Operation]+F.FieldName);
+      if not Assigned(P) then
+        Raise ESQLDBRest.CreateFmt(500,SErrFilterParamNotFound,[F.PublicName]);
+      if Assigned(FF.ValueParam) then
+        P.Value:=FF.ValueParam.Value
+      else
+        begin
+        D:=TJSONString.Create(FF.Value);
+        try
+          SetParamFromData(P,F,D)
+        finally
+          D.Free;
+        end;
+        end;
+      end;
+    end;
+  // Fill in remaining params. Determine source
+  case aOperation of
+    roGet : Sources:=[vsQuery,vsRoute];
+    roPost,
+    roPut : Sources:=[vsQuery,vsContent,vsRoute];
+    roDelete : Sources:=[vsQuery,vsRoute];
+  else
+    Sources:=AllVariableSources;
+  end;
+  For I:=0 to aQuery.Params.Count-1 do
+    begin
+    P:=aQuery.Params[i];
+    if P.IsNull then
+      try
+        D:=Nil;
+        F:=FindFieldForParam(aOperation,P);
+        D:=GetDataForParam(P,F,Sources);
+        if (D<>Nil) then
+          SetParamFromData(P,F,D)
+        else if (aOperation in [roDelete]) then
+          Raise ESQLDBRest.CreateFmt(400,SErrMissingParameter,[P.Name])
+        else
+          P.Clear;
+      finally
+        FreeAndNil(D);
+      end;
+    end;
+end;
+
+Function TSQLDBRestDBHandler.GetLimitOffset(Out aLimit,aOffset : Int64) : Boolean;
+
+begin
+  Result:=IO.GetLimitOffset(EnforceLimit,aLimit,aoffset);
+end;
+
+Function TSQLDBRestDBHandler.GetLimit : UTF8String;
+
+var
+  aOffset, aLimit : Int64;
+  CT : String;
+
+begin
+  Result:='';
+  GetLimitOffset(aLimit,aOffset);
+  if aLimit=0 then
+    exit;
+  if Not (IO.Connection is TSQLConnector) then
+    Raise ESQLDBRest.Create(500,SErrLimitNotSupported);
+  CT:=lowerCase(TSQLConnector(IO.Connection).ConnectorType);
+  if Copy(CT,1,5)='mysql' then
+    CT:='mysql';
+  case CT of
+    'mysql' : Result:=Format('LIMIT %d, %d',[aOffset,aLimit]);
+    'postgresql',
+    'sqlite3' : Result:=Format('LIMIT %d offset %d',[aLimit,aOffset]);
+    'interbase',
+    'firebird' : Result:=Format('ROWS %d TO %d',[aOffset,aOffset+aLimit-1]);
+    'oracle',
+    'sybase',
+    'odbc',
+    'MSSQLServer' : Result:=Format('OFFSET %d ROWS FETCH NEXT %d ROWS ONLY',[aOffset,aLimit]);
+  end;
+end;
+
+
+Function TSQLDBRestDBHandler.StreamRecord(O : TRestOutputStreamer; D : TDataset; FieldList : TRestFieldPairArray) : Boolean;
+
+Var
+  i : Integer;
+
+begin
+  Result:=IO.Resource.AllowRecord(D);
+  if not Result then
+    exit;
+  O.StartRow;
+  For I:=0 to Length(FieldList)-1 do
+    O.WriteField(FieldList[i]);
+  O.EndRow;
+end;
+
+Function TSQLDBRestDBHandler.StreamDataset(O : TRestOutputStreamer; D : TDataset; FieldList : TRestFieldPairArray) : Int64;
+
+Var
+  aLimit,aOffset : Int64;
+
+  Function LimitReached : boolean;
+
+  begin
+    Result:=EmulateOffsetLimit and (aLimit<=0);
+  end;
+
+Var
+  I : Integer;
+
+begin
+  Result:=0;
+  if EmulateOffsetLimit then
+    GetLimitOffset(aLimit,aOffset)
+  else
+    begin
+    aLimit:=0;
+    aOffset:=0;
+    end;
+  For I:=0 to Length(FieldList)-1 do
+    FieldList[i].DBField:=D.FieldByName(FieldList[i].RestField.FieldName);
+  if O.HasOption(ooMetadata) then
+    O.WriteMetadata(FieldList);
+  O.StartData;
+  if EmulateOffsetLimit then
+    While (aOffset>0) and not D.EOF do
+      begin
+      D.Next;
+      Dec(aOffset);
+      end;
+  While not (D.EOF or LimitReached) do
+    begin
+    If StreamRecord(O,D,FieldList) then
+      begin
+      Dec(aLimit);
+      inc(Result);
+      end;
+    D.Next;
+    end;
+  O.EndData;
+end;
+
+Function TSQLDBRestDBHandler.GetSpecialDatasetForResource(aFieldList : TRestFieldPairArray) :  TDataset;
+
+
+Var
+  aLimit,aOffset : Int64;
+
+begin
+  Result:=ExternalDataset;
+  if (Result=Nil) then
+    begin
+    GetLimitOffset(aLimit,aOffset);
+    Result:=FResource.GetDataset(aFieldList,GetOrderByFieldArray,aLimit,aOffset);
+    end;
+end;
+
+procedure TSQLDBRestDBHandler.SetExternalDataset(AValue: TDataset);
+begin
+  if FExternalDataset=AValue then Exit;
+  if Assigned(FExternalDataset) then
+    FExternalDataset.RemoveFreeNotification(Self);
+  FExternalDataset:=AValue;
+  if Assigned(FExternalDataset) then
+    FExternalDataset.FreeNotification(Self);
+end;
+
+Function TSQLDBRestDBHandler.SpecialResource : Boolean;
+
+begin
+  Result:=(ExternalDataset<>Nil) or Assigned(FResource.OnGetDataset);
+end;
+
+function TSQLDBRestDBHandler.GetDatasetForResource(aFieldList: TRestFieldPairArray; Singleton : Boolean): TDataset;
+
+Var
+  aWhere,aOrderby,aLimit,SQL : UTF8String;
+  Q : TSQLQuery;
+  WhereFilterList : TRestFilterPairArray;
+
+begin
+  if SpecialResource then
+    Exit(GetSpecialDatasetForResource(aFieldList));
+  if Singleton then
+    aWhere:=GetIDWhere(WhereFilterList)
+  else
+    aWhere:=GetWhere(WhereFilterList);
+  aOrderBy:=GetOrderBy;
+  aLimit:=GetLimit;
+  SQL:=FResource.GetResolvedSQl(skSelect,aWhere,aOrderBy,aLimit);
+  Q:=CreateQuery(SQL);
+  Try
+    FillParams(roGet,Q,WhereFilterList);
+    Result:=Q;
+  except
+    Q.Free;
+    raise;
+  end;
+end;
+
+procedure TSQLDBRestDBHandler.CreateResourceFromDataset(D : TDataset);
+
+begin
+  FOwnsResource:=True;
+  FResource:=TCustomViewResource.Create(Nil);
+  FResource.PopulateFieldsFromFieldDefs(D.FieldDefs,Nil,Nil,[]);
+end;
+
+procedure TSQLDBRestDBHandler.DoNotFound;
+
+begin
+  IO.Response.Code:=404;
+  IO.Response.CodeText:='NOT FOUND';  // Do not localize
+  IO.CreateErrorResponse;
+end;
+
+procedure TSQLDBRestDBHandler.DoHandleGet;
+
+Var
+  D : TDataset;
+  FieldList : TRestFieldPairArray;
+  qID : UTF8string;
+  Single : Boolean;
+
+begin
+  FieldList:=BuildFieldList(False);
+  Single:=(IO.GetVariable('ID',qId,[vsRoute,vsQuery])<>vsNone);
+  D:=GetDatasetForResource(FieldList,Single);
+  try
+    D.Open;
+    if DeriveResourceFromDataset then
+      begin
+      CreateResourceFromDataset(D);
+      FieldList:=BuildFieldList(False);
+      end;
+    if not (D.EOF and D.BOF) then
+      StreamDataset(IO.RESTOutput,D,FieldList)
+    else if Single then
+      DoNotFound;
+  finally
+    D.Free;
+  end;
+end;
+
+Function TSQLDBRestDBHandler.GetGeneratorValue(Const aGeneratorName : String) : Int64;
+
+begin
+  Result:=IO.Connection.GetNextValue(aGeneratorName,1);
+end;
+
+procedure TSQLDBRestDBHandler.SetPostParams(aParams : TParams; Old : TFields = Nil);
+
+Var
+  I : Integer;
+  P : TParam;
+  D : TJSONData;
+  F : TSQLDBRestField;
+  FOld : TField;
+  V : UTF8string;
+
+begin
+  For I:=0 to aParams.Count-1 do
+    try
+      D:=Nil;
+      FOld:=Nil;
+      P:=aParams[i];
+      F:=FResource.Fields.FindByFieldName(P.Name);
+      If Assigned(Fold) then
+        Fold:=Old.FindField(P.Name);
+      if (F<>Nil) then
+        begin
+        if (F.GeneratorName<>'') and (Old=Nil) then // Only when doing POST
+          D:=TJSONInt64Number.Create(GetGeneratorValue(F.GeneratorName))
+        else
+          D:=IO.RESTInput.GetContentField(F.PublicName);
+        end
+      else if IO.GetVariable(P.Name,V,[vsContent,vsQuery])<>vsNone then
+        D:=TJSONString.Create(V);
+      if (D=Nil) and Assigned(Fold) then
+        P.AssignFromField(Fold) // use old value
+      else
+        SetParamFromData(P,F,D); // Use new value, if any
+    finally
+      D.Free;
+    end;
+  // Give user a chance to look at it.
+  FResource.CheckParams(roPost,aParams);
+  // Save so it can be used in GetWHereID for return
+  FPostParams:=TParams.Create(TParam);
+  FPostParams.Assign(aParams);
+end;
+
+procedure TSQLDBRestDBHandler.InsertNewRecord;
+
+Var
+  S : TSQLStatement;
+  SQL : UTF8String;
+
+begin
+  SQL:=FResource.GetResolvedSQl(skInsert,'','','');
+  S:=TSQLStatement.Create(Self);
+  try
+    S.Database:=IO.Connection;
+    S.Transaction:=IO.Transaction;
+    S.SQL.Text:=SQL;
+    SetPostParams(S.Params);
+    S.Execute;
+    PostParams.Assign(S.Params);
+    S.Transaction.Commit;
+  Finally
+    S.Free;
+  end;
+end;
+
+procedure TSQLDBRestDBHandler.DoHandlePost;
+
+Var
+  D : TDataset;
+  FieldList : TRestFieldPairArray;
+
+begin
+  // We do this first, so we don't run any unnecessary queries
+  if not IO.RESTInput.SelectObject(0) then
+    raise ESQLDBRest.Create(400, SErrNoResourceDataFound);
+  InsertNewRecord;
+  // Now build response
+  FieldList:=BuildFieldList(False);
+  D:=GetDatasetForResource(FieldList,True);
+  try
+    D.Open;
+    IO.RESTOutput.OutputOptions:=IO.RESTOutput.OutputOptions-[ooMetadata];
+    StreamDataset(IO.RESTOutput,D,FieldList);
+  finally
+    D.Free;
+  end;
+end;
+
+procedure TSQLDBRestDBHandler.UpdateExistingRecord(OldData : TDataset);
+
+Var
+  S : TSQLStatement;
+  SQl : String;
+
+begin
+  SQL:=FResource.GetResolvedSQl(skUpdate,'','','');
+  S:=TSQLStatement.Create(Self);
+  try
+    S.Database:=IO.Connection;
+    S.Transaction:=IO.Transaction;
+    S.SQL.Text:=SQL;
+    SetPostParams(S.Params,OldData.Fields);
+    // Give user a chance to look at it.
+    FResource.CheckParams(roPut,S.Params);
+    S.Execute;
+    S.Transaction.Commit;
+  finally
+    S.Free;
+  end;
+end;
+
+procedure TSQLDBRestDBHandler.DoHandlePut;
+
+Var
+  D : TDataset;
+  FieldList : TRestFieldPairArray;
+
+begin
+  // We do this first, so we don't run any unnecessary queries
+  if not IO.RESTInput.SelectObject(0) then
+    Raise ESQLDBRest.Create(400,SErrNoResourceDataFound);
+  // Get the original record.
+  FieldList:=BuildFieldList(True);
+  D:=GetDatasetForResource(FieldList,True);
+  try
+    D.Open;
+    if (D.BOF and D.EOF) then
+      begin
+      DoNotFound;
+      exit;
+      end;
+    UpdateExistingRecord(D);
+    // Now build response
+    FreeAndNil(D);
+    FieldList:=BuildFieldList(False);
+    D:=GetDatasetForResource(FieldList,True);
+    D.Open;
+    IO.RESTOutput.OutputOptions:=IO.RESTOutput.OutputOptions-[ooMetadata];
+    StreamDataset(IO.RESTOutput,D,FieldList);
+  finally
+    D.Free;
+  end;
+end;
+
+destructor TSQLDBRestDBHandler.Destroy;
+begin
+  FreeAndNil(FPostParams);
+  If FOwnsResource then
+     FreeAndNil(FResource);
+  inherited Destroy;
+end;
+
+procedure TSQLDBRestDBHandler.Notification(AComponent: TComponent; Operation: TOperation);
+begin
+  If Operation=opRemove then
+    begin
+    if (aComponent=FExternalDataset) then
+      FExternalDataset:=Nil;
+    end;
+end;
+
+procedure TSQLDBRestDBHandler.DoHandleDelete;
+
+Var
+  aWhere,SQL : UTF8String;
+  Q : TSQLQuery;
+  FilteredFields : TRestFilterPairArray;
+
+begin
+  aWhere:=GetIDWhere(FilteredFields);
+  SQL:=FResource.GetResolvedSQl(skDelete,aWhere,'');
+  Q:=CreateQuery(SQL);
+  try
+    FillParams(roDelete,Q,FilteredFields);
+    Q.ExecSQL;
+    if Q.RowsAffected<>1 then
+      DoNotFound;
+  finally
+    Q.Free;
+  end;
+end;
+
+end.
+

packages/fcl-web/src/restbridge/sqldbrestini.pp

@@ -0,0 +1,674 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2019 by the Free Pascal development team
+
+    SQLDB REST Dispatcher .ini file load/save support.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit sqldbrestini;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, sqldbrestio, sqldbrestauth, sqldbrestbridge, sqldbrestschema, inifiles;
+
+Type
+  TConnectionIniOption = (scoClearOnRead,      // Clear values first
+                          scoSkipPassword,     // Do not save/load password
+                          scoSkipMaskPassword, // do not mask the password
+                          scoUserNameAsMask,   // use the username as mask for password
+                          scoSkipParams        // Do not read/write params.
+                         );
+  TConnectionIniOptions = Set of TConnectionIniOption;
+
+  TSQLDBRestConnectionHelper = class helper for TSQLDBRestConnection
+  Private
+    Procedure ClearValues;
+  Public
+    Procedure LoadFromIni(Const aIni: TCustomIniFile; aOptions : TConnectionIniOptions = []); overload;
+    Procedure LoadFromIni(Const aIni: TCustomIniFile; ASection : String; aOptions : TConnectionIniOptions); overload;
+    Procedure LoadFromFile(Const aFileName : String; aOptions : TConnectionIniOptions = []); overload;
+    Procedure LoadFromFile(Const aFileName : String; Const ASection : String; aOptions : TConnectionIniOptions); overload;
+    Procedure SaveToFile(Const aFileName : String; aOptions : TConnectionIniOptions = []);overload;
+    Procedure SaveToFile(Const aFileName : String; Const ASection : String; aOptions : TConnectionIniOptions = []);overload;
+    Procedure SaveToIni(Const aIni: TCustomIniFile; aOptions : TConnectionIniOptions = []); overload;
+    Procedure SaveToIni(Const aIni: TCustomIniFile; ASection : String; aOptions : TConnectionIniOptions); overload;
+  end;
+
+  TDispatcherIniOption = (dioSkipReadConnections,   // Do not Read connection definitions
+                          dioSkipExposeConnections, // Do not Expose connections defined in .ini file
+                          dioSkipReadSchemas,       // Do not Read schema definitions
+                          dioDisableSchemas,        // Do not enable schemas
+                          dioSkipWriteConnections,  // Do not write connection definitions
+                          dioSkipWriteSchemas,      // Do not Read schema definitions
+                          dioSkipBasicAuth,         // Do not read/write basic auth data.
+                          dioSkipStringConfig       // Do not read strings config
+                          );
+  TDispatcherIniOptions = set of TDispatcherIniOption;
+
+  { TSQLDBRestDispatcherHelper }
+
+  TSQLDBRestDispatcherHelper = class helper for TSQLDBRestDispatcher
+  private
+  Public
+    procedure ReadSchemas(const aIni: TCustomIniFile; ASection: String; aOptions: TDispatcherIniOptions);
+    procedure ReadConnections(const aIni: TCustomIniFile; ASection: String);
+    procedure WriteConnections(const aIni: TCustomIniFile; ASection: String; aOptions : TConnectionIniOptions);
+    procedure WriteSchemas(const aIni: TCustomIniFile; ASection: String; SchemaFileDir : String);
+    Procedure LoadFromIni(Const aIni: TCustomIniFile; aOptions : TDispatcherIniOptions = []); overload;
+    Procedure LoadFromIni(Const aIni: TCustomIniFile; ASection : String; aOptions : TDispatcherIniOptions); overload;
+    Procedure LoadFromFile(Const aFileName : String; aOptions : TDispatcherIniOptions = []); overload;
+    Procedure LoadFromFile(Const aFileName : String; Const ASection : String; aOptions : TDispatcherIniOptions); overload;
+    Procedure SaveToFile(Const aFileName : String; aOptions : TDispatcherIniOptions = []);overload;
+    Procedure SaveToFile(Const aFileName : String; Const ASection : String; aOptions : TDispatcherIniOptions = []);overload;
+    Procedure SaveToIni(Const aIni: TCustomIniFile; aOptions : TDispatcherIniOptions = []); overload;
+    Procedure SaveToIni(Const aIni: TCustomIniFile; ASection : String; aOptions : TDispatcherIniOptions); overload;
+  end;
+
+  { TRestStringsConfigHelper }
+
+  TRestStringsConfigHelper = class helper for TRestStringsConfig
+  Public
+    Procedure LoadFromIni(Const aIni: TCustomIniFile); overload;
+    Procedure LoadFromIni(Const aIni: TCustomIniFile; ASection : String); overload;
+    Procedure LoadFromFile(Const aFileName : String); overload;
+    Procedure LoadFromFile(Const aFileName : String; Const ASection : String); overload;
+    Procedure SaveToFile(Const aFileName : String);overload;
+    Procedure SaveToFile(Const aFileName : String; Const ASection : String);overload;
+    Procedure SaveToIni(Const aIni: TCustomIniFile); overload;
+    Procedure SaveToIni(Const aIni: TCustomIniFile; ASection : String); overload;
+  end;
+
+
+Function StrToOutputOptions(S : String) : TRestOutputOptions;
+Function StrToDispatcherOptions(S : String) : TRestDispatcherOptions;
+Function StrToConnectionIniOptions(S : String) : TConnectionIniOptions;
+Function OutputOptionsToStr(Options : TRestOutputOptions): String;
+Function DispatcherOptionsToStr(Options: TRestDispatcherOptions) : String;
+Function ConnectionIniOptionsToStr(Options: TConnectionIniOptions): String;
+
+Var
+  TrivialEncryptKey : String = 'SQLDB';
+  DefaultConnectionSection : String = 'Connection';
+  DefaultDispatcherSection : String = 'Dispatcher';
+  DefaultStringsConfigSection : String = 'Dispatcher_strings';
+
+implementation
+
+uses typinfo,strutils, sqldbrestauthini;
+
+Const
+  KeyHost = 'Host';
+  KeyDatabaseName = 'DatabaseName';
+  KeyUserName = 'UserName';
+  KeyPassword = 'Password';
+  KeyPort = 'Port';
+  keyParams = 'Params';
+  KeyCharset = 'Charset';
+  KeyRole = 'Role';
+  KeyType = 'Type';
+  KeyConnections = 'Connections';
+  KeySchemas = 'Schemas';
+  keyDispatcherOptions = 'DispatcherOptions';
+  keyOutputOptions = 'OutputOptions';
+  KeyBasePath = 'BasePath';
+  KeyDefaultConnection = 'DefaultConnection';
+  KeyEnforceLimit = 'EnforceLimit';
+  KeyCORSAllowedOrigins = 'CORSAllowedOrigins';
+  KeyLoadOptions = 'LoadOptions';
+  KeyMinFieldOptions = 'MinFieldOptions';
+  KeyFileName = 'File';
+  KeyEnabled = 'Enabled';
+  KeyBasicAuth = 'BasicAuth';
+
+Function StrToOutputOptions(S : String) : TRestOutputOptions;
+
+var
+  i : integer;
+
+begin
+  I:=StringToSet(PTypeInfo(TypeInfo(TRestOutputOptions)),S);
+  Result:=TRestOutputOptions(I);
+end;
+
+Function StrToDispatcherOptions(S : String) : TRestDispatcherOptions;
+
+var
+  i : integer;
+
+begin
+  I:=StringToSet(PTypeInfo(TypeInfo(TRestDispatcherOptions)),S);
+  Result:=TRestDispatcherOptions(I);
+end;
+
+Function StrToConnectionIniOptions(S : String) : TConnectionIniOptions;
+
+var
+  i : integer;
+
+begin
+  I:=StringToSet(PTypeInfo(TypeInfo(TConnectionIniOptions)),S);
+  Result:=TConnectionIniOptions(I);
+end;
+
+Function StrToRestFieldOptions(S : String) : TRestFieldOptions;
+
+var
+  i : integer;
+
+begin
+  I:=StringToSet(PTypeInfo(TypeInfo(TRestFieldOptions)),S);
+  Result:=TRestFieldOptions(I);
+end;
+
+Function OutputOptionsToStr(Options  : TRestOutputOptions): String;
+
+begin
+  Result:=SetToString(PTypeInfo(TypeInfo(TRestOutputOptions)),Integer(Options),False);
+end;
+
+Function DispatcherOptionsToStr(Options : TRestDispatcherOptions) : String;
+
+begin
+  Result:=SetToString(PTypeInfo(TypeInfo(TRestDispatcherOptions)),Integer(Options),false);
+end;
+
+Function ConnectionIniOptionsToStr(Options : TConnectionIniOptions): String;
+
+begin
+  Result:=SetToString(PTypeInfo(TypeInfo(TConnectionIniOptions)),Integer(Options),false);
+end;
+
+{ TRestStringsConfigHelper }
+
+procedure TRestStringsConfigHelper.LoadFromIni(const aIni: TCustomIniFile);
+begin
+  LoadFromIni(aIni,DefaultStringsConfigSection);
+end;
+
+procedure TRestStringsConfigHelper.LoadFromIni(const aIni: TCustomIniFile; ASection: String);
+
+Var
+  T : TRestStringProperty;
+  N : String;
+  S : UTF8String;
+
+begin
+  For T in TRestStringProperty do
+    begin
+    Str(T,N);
+    Delete(N,1,2);
+    S:=aIni.ReadString(aSection, N, GetRestString(T));
+    SetRestString(T,S);
+    end;
+end;
+
+procedure TRestStringsConfigHelper.LoadFromFile(const aFileName: String);
+begin
+  LoadFromFile(aFileName,DefaultStringsConfigSection);
+end;
+
+procedure TRestStringsConfigHelper.LoadFromFile(const aFileName: String; const ASection: String);
+Var
+  Ini : TCustomIniFile;
+
+begin
+  Ini:=TMeminiFile.Create(aFileName);
+  try
+    LoadFromIni(Ini,aSection);
+  finally
+    Ini.Free;
+  end;
+end;
+
+procedure TRestStringsConfigHelper.SaveToFile(const aFileName: String);
+begin
+  SaveToFile(aFileName,DefaultStringsConfigSection);
+end;
+
+procedure TRestStringsConfigHelper.SaveToFile(const aFileName: String; const ASection: String);
+Var
+  Ini : TCustomIniFile;
+
+begin
+  Ini:=TMeminiFile.Create(aFileName);
+  try
+    SaveToIni(Ini,aSection);
+    Ini.UpdateFile;
+  finally
+    Ini.Free;
+  end;
+end;
+
+procedure TRestStringsConfigHelper.SaveToIni(const aIni: TCustomIniFile);
+begin
+  SaveToini(aIni,DefaultStringsConfigSection);
+end;
+
+procedure TRestStringsConfigHelper.SaveToIni(const aIni: TCustomIniFile; ASection: String);
+Var
+  T : TRestStringProperty;
+  N : String;
+
+begin
+  For T in TRestStringProperty do
+    begin
+    Str(T,N);
+    Delete(N,1,2);
+    aIni.WriteString(aSection, N, GetRestString(T));
+    end;
+end;
+
+
+
+{ TSQLDBRestDispatcherHelper }
+
+procedure TSQLDBRestDispatcherHelper.LoadFromIni(const aIni: TCustomIniFile; aOptions: TDispatcherIniOptions);
+begin
+  LoadFromIni(aIni,DefaultDispatcherSection,aOptions);
+end;
+
+procedure TSQLDBRestDispatcherHelper.ReadConnections(const aIni: TCustomIniFile; ASection: String);
+
+Var
+  S,L : String;
+  I : Integer;
+  C : TSQLDBRestConnection;
+  CIO : TConnectionIniOptions;
+begin
+  // Read connections
+  L:=aIni.ReadString(aSection,KeyConnections,'');
+  For I:=1 to WordCount(L,[',']) do
+    begin
+    S:=ExtractWord(I,L,[',']);
+    C:=Connections.AddConnection('','','','','');
+    C.Name:=S;
+    CIO:=StrToConnectionIniOptions(aIni.ReadString(S,KeyLoadOptions,''));
+    C.LoadFromIni(aIni,S,CIO);
+    end;
+end;
+
+procedure TSQLDBRestDispatcherHelper.WriteConnections(const aIni: TCustomIniFile; ASection: String; aOptions: TConnectionIniOptions);
+
+Var
+  S,L : String;
+  I : Integer;
+
+begin
+  L:='';
+  for I:=0 to Connections.Count-1 do
+    begin
+    if (L<>'') then
+      L:=L+',';
+    L:=L+Connections[i].Name;
+    end;
+  aIni.WriteString(aSection,KeyConnections,L);
+  for I:=0 to Connections.Count-1 do
+    begin
+    S:=Connections[i].Name;
+    L:=ConnectionIniOptionsToStr(aOptions);
+    Connections[i].SaveToIni(aIni,S,aOptions);
+    aIni.WriteString(S,KeyLoadOptions,L);
+    end;
+end;
+
+procedure TSQLDBRestDispatcherHelper.WriteSchemas(const aIni: TCustomIniFile; ASection: String; SchemaFileDir : String);
+
+Var
+  S,L,FN : String;
+  I : Integer;
+  Sch : TSQLDBRestSchema;
+
+
+begin
+  // Read Schemas
+  L:='';
+  for I:=0 to Schemas.Count-1 do
+    if Assigned(Schemas[i].Schema) then
+      begin
+      if (L<>'') then
+        L:=L+',';
+      L:=L+Schemas[i].Schema.Name;
+      end;
+  aIni.WriteString(aSection,KeySchemas,L);
+  for I:=0 to Schemas.Count-1 do
+    if Assigned(Schemas[i].Schema) then
+      begin
+      S:=Schemas[i].Schema.Name;
+      Sch:=Schemas[i].Schema;
+      if (SchemaFileDir<>'') then
+        FN:=IncludeTrailingPathDelimiter(SchemaFileDir)+S+'.json'
+      else
+        FN:='';
+      aIni.WriteString(S,KeyFileName,FN);
+      aIni.WriteBool(S,KeyEnabled,Schemas[i].Enabled);
+      if (FN<>'') then
+        Sch.SaveToFile(FN);
+    end;
+end;
+
+procedure TSQLDBRestDispatcherHelper.ReadSchemas(const aIni: TCustomIniFile; ASection: String; aOptions: TDispatcherIniOptions);
+
+Var
+  S,L,FN : String;
+  I : Integer;
+  Sch : TSQLDBRestSchema;
+  SRef : TSQLDBRestSchemaRef;
+
+
+begin
+  // Read Schemas
+  L:=aIni.ReadString(aSection,KeySchemas,'');
+  For I:=1 to WordCount(L,[',']) do
+    begin
+    S:=ExtractWord(I,L,[',']);
+    Sch:=TSQLDBRestSchema.Create(Self);
+    Sch.Name:=S;
+    SRef:=Schemas.AddSchema(Sch);
+    SRef.Enabled:=aIni.ReadBool(S,KeyEnabled,True);
+    if (dioDisableSchemas in aOptions) then
+      SRef.Enabled:=False;
+    FN:=aIni.ReadString(S,KeyFileName,'');
+    if (FN<>'') then
+      Sch.LoadFromFile(FN);
+    end;
+end;
+
+procedure TSQLDBRestDispatcherHelper.LoadFromIni(const aIni: TCustomIniFile; ASection: String; aOptions: TDispatcherIniOptions);
+
+Var
+  I : Integer;
+  FO : TRestFieldOptions;
+  BAN : String;
+  BA : TRestBasicAuthenticator;
+  BAO : TBasicAuthIniOptions;
+
+begin
+  DispatchOptions:=StrToDispatcherOptions(aIni.ReadString(aSection,keyDispatcherOptions,''));
+  OutputOptions:=StrToOutputOptions(aIni.ReadString(aSection,keyOutputOptions,''));
+  BasePath:=aIni.ReadString(aSection,KeyBasePath,'');
+  DefaultConnection:=aIni.ReadString(aSection,KeyDefaultConnection,'');
+  EnforceLimit:=aIni.ReadInteger(aSection,KeyEnforceLimit,0);
+  CORSAllowedOrigins:=aIni.ReadString(aSection,KeyCORSAllowedOrigins,'');
+  if Not (dioSkipReadConnections in aOptions) then
+    ReadConnections(aIni,aSection);
+  if Not (dioSkipReadSchemas in aOptions) then
+    ReadSchemas(aIni,aSection,aOptions);
+  // Expose connections
+  if not (dioSkipExposeConnections in aOptions) then
+    for I:=0 to Connections.Count-1 do
+      if Connections[i].Enabled then
+        begin
+        FO:=StrToRestFieldOptions(aIni.ReadString(Connections[i].Name,KeyMinFieldOptions,''));
+        ExposeConnection(Connections[i],Nil,FO);
+        end;
+  if not (dioSkipBasicAuth in aOptions) then
+    begin
+    BAN:=aIni.ReadString(aSection,KeyBasicAuth,'');
+    if BAN<>'' then
+      begin
+      BAO:=StrToBasicAuthIniOptions(aIni.ReadString(BAN,keyLoadOptions,''));
+      BA:=TRestBasicAuthenticator.Create(Self);
+      BA.Name:=BAN;
+      BA.LoadFromIni(aIni,BAN,BAO);
+      Self.Authenticator:=BA;
+      end;
+    end;
+  if not (dioSkipStringConfig in aOptions) then
+    Strings.LoadFromIni(aIni,aSection+'_strings');
+end;
+
+procedure TSQLDBRestDispatcherHelper.LoadFromFile(const aFileName: String; aOptions: TDispatcherIniOptions);
+begin
+  Loadfromfile(aFileName,DefaultDispatcherSection,aOptions);
+end;
+
+procedure TSQLDBRestDispatcherHelper.LoadFromFile(const aFileName: String; const ASection: String; aOptions: TDispatcherIniOptions);
+
+Var
+  Ini : TCustomIniFile;
+
+begin
+  Ini:=TMeminiFile.Create(aFileName);
+  try
+    LoadFromIni(Ini,aSection,aOptions);
+  finally
+    Ini.Free;
+  end;
+end;
+
+procedure TSQLDBRestDispatcherHelper.SaveToFile(const aFileName: String; aOptions: TDispatcherIniOptions);
+begin
+  SaveTofile(aFileName,DefaultDispatcherSection,aOptions);
+end;
+
+procedure TSQLDBRestDispatcherHelper.SaveToFile(const aFileName: String; const ASection: String; aOptions: TDispatcherIniOptions);
+Var
+  Ini : TCustomIniFile;
+
+begin
+  Ini:=TMeminiFile.Create(aFileName);
+  try
+    SaveToIni(Ini,aSection,aOptions);
+    Ini.UpdateFile;
+  finally
+    Ini.Free;
+  end;
+end;
+
+procedure TSQLDBRestDispatcherHelper.SaveToIni(const aIni: TCustomIniFile; aOptions: TDispatcherIniOptions);
+begin
+  SaveToIni(aIni,DefaultDispatcherSection,aOptions);
+end;
+
+procedure TSQLDBRestDispatcherHelper.SaveToIni(const aIni: TCustomIniFile; ASection: String; aOptions: TDispatcherIniOptions);
+
+Var
+  BAN : String;
+
+begin
+  aIni.WriteString(aSection,keyDispatcherOptions,DispatcherOptionsToStr(DispatchOptions));
+  aIni.WriteString(aSection,keyOutputOptions,OutputOptionsToStr(OutputOptions));
+  aIni.WriteString(aSection,KeyBasePath,BasePath);
+  aIni.WriteString(aSection,KeyDefaultConnection,DefaultConnection);
+  aIni.WriteInteger(aSection,KeyEnforceLimit,EnforceLimit);
+  aIni.WriteString(aSection,KeyCORSAllowedOrigins,CORSAllowedOrigins);
+  if Not (dioSkipWriteConnections in aOptions) then
+    WriteConnections(aIni,aSection,[]);
+  if Not (dioSkipWriteSchemas in aOptions) then
+    WriteSchemas(aIni,aSection,ExtractFilePath(ExpandFileName(aIni.FileName)));
+  if not (dioSkipBasicAuth in aOptions) then
+    if Assigned(Authenticator) and (Authenticator is TRestBasicAuthenticator) then
+      begin
+      BAN:=Authenticator.Name;
+      if BAN='' then
+        BAN:=Self.Name+'_basicauth';
+      TRestBasicAuthenticator(Authenticator).SaveToIni(aIni,BAN,[]);
+      aIni.WriteString(aSection,KeyBasicAuth,BAN);
+      end;
+  if not (dioSkipStringConfig in aOptions) then
+    Strings.SaveToIni(aIni,aSection+'_strings');
+end;
+
+{ TSQLDBRestConnectionHelper }
+
+procedure TSQLDBRestConnectionHelper.ClearValues;
+begin
+  HostName:='';
+  DatabaseName:='';
+  UserName:='';
+  Password:='';
+  CharSet:='';
+  Params.Clear;
+  Port:=0;
+end;
+
+
+
+Const
+  ForbiddenParamKeys : Array[1..8] of unicodestring
+                     = (keyHost,KeyDatabaseName,KeyUserName,KeyPassword,KeyPort,keyParams,keyCharSet,keyRole);
+  ParamSeps = [',',';',' '];
+
+procedure TSQLDBRestConnectionHelper.LoadFromIni(const aIni: TCustomIniFile; ASection: String; aOptions: TConnectionIniOptions);
+
+Var
+  M,N,P : String;
+  I : integer;
+
+begin
+  With aIni do
+    begin
+    if (scoClearOnRead in aOptions) then
+       ClearValues;
+    ConnectionType:=ReadString(ASection,KeyType,'');
+    HostName:=ReadString(ASection,KeyHost,HostName);
+    DatabaseName:=ReadString(ASection,KeyDatabaseName,DatabaseName);
+    UserName:=ReadString(ASection,KeyUserName,UserName);
+    CharSet:=ReadString(ASection,KeyCharSet,CharSet);
+    Role:=ReadString(ASection,KeyRole,Role);
+    Port:=ReadInteger(ASection,KeyPort,Port);
+    Enabled:=ReadBool(ASection,KeyEnabled,True);
+    // optional parts
+    if not (scoSkipPassword in aOptions) then
+      begin
+      if scoSkipMaskPassword in aOptions then
+        P:=ReadString(ASection,KeyPassword,Password)
+      else
+        begin
+        P:=ReadString(ASection,KeyPassword,'');
+        if (P<>'') then
+          begin
+          if scoUserNameAsMask in aOptions then
+            M:=UserName
+          else
+            M:=TrivialEncryptKey;
+          P:=XorDecode(M,P);
+          end;
+        end;
+      Password:=P;
+      end;
+    if not (scoSkipParams in aOptions) then
+      begin
+      M:=ReadString(ASection,keyParams,'');
+      For I:=1 to WordCount(M,ParamSeps) do
+        begin
+        N:=ExtractWord(I,M,ParamSeps);
+        if IndexStr(Utf8Decode(N),ForbiddenParamKeys)=-1 then
+          begin
+          P:=ReadString(ASection,N,'');
+          Params.Values[N]:=P;
+          end;
+        end;
+      end;
+    end;
+end;
+
+procedure TSQLDBRestConnectionHelper.LoadFromIni(const aIni: TCustomIniFile; aOptions: TConnectionIniOptions);
+begin
+  LoadFromIni(aIni,DefaultConnectionSection,aOptions);
+end;
+
+procedure TSQLDBRestConnectionHelper.LoadFromFile(const aFileName: String; aOptions: TConnectionIniOptions);
+
+
+begin
+  Loadfromfile(aFileName,DefaultConnectionSection,aOptions);
+end;
+
+procedure TSQLDBRestConnectionHelper.LoadFromFile(const aFileName: String; const ASection: String; aOptions: TConnectionIniOptions);
+
+Var
+  Ini : TCustomIniFile;
+
+begin
+  Ini:=TMeminiFile.Create(aFileName);
+  try
+    LoadFromIni(Ini,aSection,aOptions);
+  finally
+    Ini.Free;
+  end;
+end;
+
+procedure TSQLDBRestConnectionHelper.SaveToFile(const aFileName: String; aOptions: TConnectionIniOptions);
+begin
+  SaveToFile(aFileName,DefaultConnectionSection,aOptions);
+end;
+
+procedure TSQLDBRestConnectionHelper.SaveToFile(const aFileName: String; const ASection: String; aOptions: TConnectionIniOptions);
+Var
+  Ini : TCustomIniFile;
+
+begin
+  Ini:=TMeminiFile.Create(aFileName);
+  try
+    SaveToini(Ini,aSection,aOptions);
+    Ini.UpdateFile;
+  finally
+    Ini.Free;
+  end;
+end;
+
+procedure TSQLDBRestConnectionHelper.SaveToIni(const aIni: TCustomIniFile; aOptions: TConnectionIniOptions);
+begin
+  SaveToIni(aIni,DefaultConnectionSection,aOptions);
+end;
+
+procedure TSQLDBRestConnectionHelper.SaveToIni(const aIni: TCustomIniFile; ASection: String; aOptions: TConnectionIniOptions);
+Var
+  M,N,P : String;
+  I : integer;
+
+begin
+  With aIni do
+    begin
+    WriteString(ASection,KeyHost,HostName);
+    WriteString(ASection,KeyDatabaseName,DatabaseName);
+    WriteString(ASection,KeyUserName,UserName);
+    WriteString(ASection,KeyCharSet,CharSet);
+    WriteString(ASection,KeyType,ConnectionType);
+    WriteString(ASection,KeyRole,Role);
+    WriteInteger(ASection,KeyPort,Port);
+    WriteBool(ASection,KeyEnabled,Enabled);
+    if not (scoSkipPassword in aOptions) then
+      begin
+      P:=Password;
+      if Not (scoSkipMaskPassword in aOptions) then
+        begin
+        if scoUserNameAsMask in aOptions then
+          M:=UserName
+        else
+          M:=TrivialEncryptKey;
+        P:=XorEncode(M,P);
+        end;
+      WriteString(ASection,KeyPassword,P);
+      end;
+    if not (scoSkipParams in aOptions) then
+      begin
+      M:='';
+      for I:=0 to Params.Count-1 do
+        begin
+        Params.GetNameValue(I,N,P);
+        if (N<>'') and (IndexStr(Utf8Decode(N),ForbiddenParamKeys)=-1) then
+          begin
+          WriteString(ASection,N,P);
+          if (M<>'') then
+            M:=M+',';
+          M:=M+N;
+          end;
+        end;
+      WriteString(ASection,KeyParams,M);
+      end;
+    end;
+end;
+
+end.

packages/fcl-web/src/restbridge/sqldbrestio.pp

@@ -0,0 +1,851 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2019 by the Free Pascal development team
+
+    SQLDB REST Dispatcher basic I/O environment.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit sqldbrestio;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpjson, sqldb, db, httpdefs, sqldbrestschema;
+
+Type
+  TVariableSource = (vsNone,vsQuery,vsContent,vsRoute,vsHeader);
+  TVariableSources = Set of TVariableSource;
+
+  TRestOutputOption = (ooMetadata,ooSparse,ooHumanReadable);
+  TRestOutputOptions = Set of TRestOutputOption;
+
+  TNullBoolean = (nbNone,nbFalse,nbTrue);
+  TNullBooleans = set of TNullBoolean;
+
+Const
+  AllVariableSources = [Low(TVariableSource)..High(TVariableSource)];
+  allOutputOptions = [Low(TRestOutputOption)..High(TRestOutputOption)];
+
+
+Type
+  TRestStringProperty = (rpDateFormat,
+                         rpDateTimeFormat,
+                         rpTimeFormat,
+                         rpDataRoot,
+                         rpMetaDataRoot,
+                         rpErrorRoot,
+                         rpFieldNameProp,
+                         rpFieldTypeProp,
+                         rpFieldDateFormatProp,
+                         rpFieldMaxLenProp,
+                         rpHumanReadable,
+                         rpFieldList,
+                         rpExcludeFieldList,
+                         rpConnection,
+                         rpResource,
+                         rpIncludeMetadata,
+                         rpSparse,
+                         rpRowName,
+                         rpMetaDataFields,
+                         rpMetaDataField,
+                         rpErrorCode,
+                         rpErrorMessage,
+                         rpFilterEqual,
+                         rpFilterLessThan,
+                         rpFilterGreaterThan,
+                         rpFilterLessThanEqual,
+                         rpFilterGreaterThanEqual,
+                         rpFilterIsNull,
+                         rpLimit,
+                         rpOffset,
+                         rpOrderBy,
+                         rpMetadataResourceName,
+                         rpInputFormat,
+                         rpOutputFormat,
+                         rpCustomViewResourceName,
+                         rpCustomViewSQLParam,
+                         rpXMLDocumentRoot
+                         );
+  TRestStringProperties = Set of TRestStringProperty;
+
+  TRestGetVariableEvent = Procedure (Sender : TObject; Const aName : UTF8String; Out aVal : UTF8String) of object;
+
+  { TRestStringsConfig }
+
+  TRestStringsConfig = Class(TPersistent)
+  private
+    FValues : Array[TRestStringProperty] of UTF8String;
+    function GetRestPropName(AIndex: Integer): UTF8String;
+    procedure SetRestPropName(AIndex: Integer; AValue: UTF8String);
+  Public
+    Class Function GetDefaultString(aString : TRestStringProperty) :UTF8String;
+    Function GetRestString(aString : TRestStringProperty) :UTF8String;
+    Procedure SetRestString(aString : TRestStringProperty; AValue :UTF8String);
+    Procedure Assign(aSource : TPersistent); override;
+  Published
+    // Indexes here MUST match TRestProperty
+    Property RESTDateFormat : UTF8String Index ord(rpDateFormat) Read GetRestPropName Write SetRestPropName;
+    Property RESTDateTimeFormat : UTF8String Index ord(rpDateTimeFormat)  Read GetRestPropName Write SetRestPropName;
+    Property RESTTimeFormat : UTF8String Index ord(rpTimeFormat)  Read GetRestPropName Write SetRestPropName;
+    Property DataProperty : UTF8String Index ord(rpDataRoot) Read GetRestPropName Write SetRestPropName;
+    Property MetaDataRoot : UTF8String Index ord(rpMetaDataRoot) Read GetRestPropName Write SetRestPropName;
+    Property ErrorProperty : UTF8String Index ord(rpErrorRoot) Read GetRestPropName Write SetRestPropName;
+    Property FieldNameProperty : UTF8String Index ord(rpFieldNameProp) Read GetRestPropName Write SetRestPropName;
+    Property FieldTypeProperty : UTF8String Index ord(rpFieldTypeProp) Read GetRestPropName Write SetRestPropName;
+    Property DateFormatProperty : UTF8String Index ord(rpFieldDateFormatProp) Read GetRestPropName Write SetRestPropName;
+    Property MaxLenProperty : UTF8String Index ord(rpFieldMaxLenProp) Read GetRestPropName Write SetRestPropName;
+    Property HumanReadableParam : UTF8String Index ord(rpHumanReadable) Read GetRestPropName Write SetRestPropName;
+    Property FieldListParam : UTF8String Index ord(rpFieldList) Read GetRestPropName Write SetRestPropName;
+    Property ExcludeFieldListParam : UTF8String Index ord(rpExcludeFieldList) Read GetRestPropName Write SetRestPropName;
+    Property ConnectionParam : UTF8String Index Ord(rpConnection) Read GetRestPropName Write SetRestPropName;
+    Property ResourceParam : UTF8String Index ord(rpResource) Read GetRestPropName Write SetRestPropName;
+    Property IncludeMetadataParam : UTF8String Index ord(rpIncludeMetadata) Read GetRestPropName Write SetRestPropName;
+    Property SparseParam : UTF8String Index Ord(rpSparse) Read GetRestPropName Write SetRestPropName;
+    Property RowName : UTF8String Index Ord(rpRowName) Read GetRestPropName Write SetRestPropName;
+    Property MetadataFields : UTF8String Index Ord(rpMetadataFields) Read GetRestPropName Write SetRestPropName;
+    Property MetadataField : UTF8String Index Ord(rpMetadataField) Read GetRestPropName Write SetRestPropName;
+    Property ErrorCode : UTF8String Index ord(rpErrorCode) Read GetRestPropName Write SetRestPropName;
+    Property ErrorMessage : UTF8String Index ord(rpErrorMessage) Read GetRestPropName Write SetRestPropName;
+    Property FilterParamEqual : UTF8String Index ord(rpFilterEqual) Read GetRestPropName Write SetRestPropName;
+    Property FilterParamLessThan : UTF8String Index ord(rpFilterLessThan) Read GetRestPropName Write SetRestPropName;
+    Property FilterParamGreaterThan : UTF8String Index ord(rpFilterGreaterThan) Read GetRestPropName Write SetRestPropName;
+    Property FilterParamLessThanEqual : UTF8String Index ord(rpFilterLessThanEqual) Read GetRestPropName Write SetRestPropName;
+    Property FilterParamGreaterThanEqual : UTF8String Index ord(rpFilterGreaterThanEqual) Read GetRestPropName Write SetRestPropName;
+    Property FilterParamIsNull : UTF8String Index ord(rpFilterIsNull) Read GetRestPropName Write SetRestPropName;
+    Property LimitParam : UTF8string Index ord(rpLimit) Read GetRestPropName Write SetRestPropName;
+    Property OffsetParam : UTF8string Index ord(rpOffset) Read GetRestPropName Write SetRestPropName;
+    Property SortParam : UTF8string Index ord(rpOrderBy) Read GetRestPropName Write SetRestPropName;
+    Property MetadataResourceName : UTF8string Index ord(rpMetadataResourceName) Read GetRestPropName Write SetRestPropName;
+    Property InputFormatParam : UTF8string Index ord(rpInputFormat) Read GetRestPropName Write SetRestPropName;
+    Property OutputFormatParam : UTF8string Index ord(rpOutputFormat) Read GetRestPropName Write SetRestPropName;
+    Property CustomViewResourceName : UTF8string Index ord(rpCustomViewResourceName) Read GetRestPropName Write SetRestPropName;
+    Property CustomViewSQLParam : UTF8string Index ord(rpCustomViewSQLParam) Read GetRestPropName Write SetRestPropName;
+    Property XMLDocumentRoot : UTF8string Index ord(rpXMLDocumentRoot) Read GetRestPropName Write SetRestPropName;
+  end;
+
+  { TRestStreamer }
+
+  TRestStreamer = Class(TObject)
+  private
+    FStream: TStream;
+    FOnGetVar : TRestGetVariableEvent;
+    FStrings: TRestStringsConfig;
+  Public
+    // Registry
+    Class Function GetContentType : String; virtual;
+    Constructor Create(aStream : TStream;aStrings : TRestStringsConfig;aOnGetVar : TRestGetVariableEvent);
+    Function GetString(aString : TRestStringProperty) : UTF8String;
+    Property Strings : TRestStringsConfig Read FStrings;
+    procedure InitStreaming; virtual; abstract;
+    Function GetVariable(const aName : UTF8String) : UTF8String;
+    Property Stream : TStream Read FStream;
+  end;
+  TRestStreamerClass = Class of TRestStreamer;
+
+  TRestInputStreamer = Class(TRestStreamer)
+  Public
+    // Select input object aIndex. Must return False if no such object in input
+    // Currently aIndex=0, but for batch operations this may later become nonzero.
+    Function SelectObject(aIndex : Integer) : Boolean; virtual; abstract;
+    // Return Nil if none found. If result is non-nil, caller will free.
+    Function GetContentField(aName : UTF8string) : TJSONData; virtual; abstract;
+    Class Procedure RegisterStreamer(Const aName : String);
+    Class Procedure UnRegisterStreamer(Const aName : String);
+  end;
+  TRestInputStreamerClass = Class of TRestInputStreamer;
+
+  { TRestOutputStreamer }
+
+  TRestOutputStreamer = Class(TRestStreamer)
+  private
+    FOutputOptions: TRestOutputOptions;
+  Protected
+    procedure SetOutputOptions(AValue: TRestOutputOptions); virtual;
+  Public
+    Class Procedure RegisterStreamer(Const aName : String);
+    Class Procedure UnRegisterStreamer(Const aName : String);
+    function RequireMetadata : Boolean; virtual;
+    Function FieldToString(aFieldType : TRestFieldType; F : TField) : UTF8string; virtual;
+    function FieldToBase64(F: TField): UTF8String; virtual;
+    Function HasOption(aOption : TRestOutputOption) : Boolean;
+    Procedure CreateErrorContent(aCode : Integer; Const aMessage: String); virtual; abstract;
+    Procedure CreateErrorContent(aCode : Integer; Const Fmt: String; Const Args : Array of const);
+    Procedure WriteMetadata(aFieldList : TRestFieldPairArray); virtual; abstract;
+    Procedure StartData; virtual; abstract;
+    Procedure StartRow; virtual; abstract;
+    Procedure WriteField(aPair : TRestFieldPair); virtual; abstract;
+    Procedure EndRow; virtual; abstract;
+    Procedure EndData; virtual; abstract;
+    Procedure FinalizeOutput; virtual; abstract;
+    // Set before InitStreaming is called;
+    Property OutputOptions : TRestOutputOptions Read FOutputOptions Write SetOutputOptions;
+  end;
+  TRestOutputStreamerClass = class of TRestOutputStreamer;
+
+  { TRestIO }
+
+  TRestIO = Class
+  private
+    FConn: TSQLConnection;
+    FCOnnection: UTF8String;
+    FInput: TRestInputStreamer;
+    FOperation: TRestOperation;
+    FOutput: TRestOutputStreamer;
+    FRequest: TRequest;
+    FResource: TSQLDBRestResource;
+    FResourceName: UTF8String;
+    FResponse: TResponse;
+    FRestStrings: TRestStringsConfig;
+    FSchema: UTF8String;
+    FTrans: TSQLTransaction;
+    FContentStream : TStream;
+    FUserID: String;
+  Protected
+  Public
+    Constructor Create(aRequest : TRequest; aResponse : TResponse); virtual;
+    Destructor Destroy; override;
+    // Set things.
+    Procedure SetIO(aInput : TRestInputStreamer;aOutput : TRestOutputStreamer);
+    Procedure SetConn(aConn : TSQLConnection; ATrans : TSQLTransaction);
+    Procedure SetResource(aResource : TSQLDBRestResource);
+    procedure SetOperation(aOperation : TRestOperation);
+    Procedure SetRestStrings(aValue : TRestStringsConfig);
+    // Get things
+    class function StrToNullBoolean(S: String; Strict: Boolean): TNullBoolean;
+    Procedure DoGetVariable(Sender : TObject; Const aName : UTF8String; Out aVal : UTF8String);
+    Function GetVariable (Const aName : UTF8String; Out aVal : UTF8String; AllowedSources : TVAriableSources = AllVariableSources) : TVariableSource; virtual;
+    function GetFilterVariable(const aName: UTF8String; AFilter: TRestFieldFilter; out aValue: UTF8String): TVariableSource;
+    Function GetBooleanVar(Const aName : UTF8String; aStrict : Boolean = False) : TNullBoolean;
+    function GetRequestOutputOptions(aDefault: TRestOutputOptions): TRestOutputOptions;
+    function GetLimitOffset(aEnforceLimit: Int64; out aLimit, aOffset: Int64): boolean;
+    // Create error response in output
+    Procedure CreateErrorResponse;
+    Property Operation : TRestOperation Read FOperation;
+    // Not owned by TRestIO
+    Property Request : TRequest read FRequest;
+    Property Response : TResponse read FResponse;
+    Property Connection : TSQLConnection Read FConn Write FConn;
+    Property Transaction : TSQLTransaction Read FTrans Write FTrans;
+    Property Resource : TSQLDBRestResource Read FResource;
+    Property RestStrings : TRestStringsConfig Read FRestStrings;
+    // owned by TRestIO
+    Property RESTInput : TRestInputStreamer read FInput;
+    Property RESTOutput : TRestOutputStreamer read FOutput;
+    Property RequestContentStream : TStream Read FContentStream;
+    // For informative purposes
+    Property ResourceName : UTF8String Read FResourceName;
+    Property Schema : UTF8String Read FSchema;
+    Property ConnectionName : UTF8String Read FCOnnection;
+    Property UserID : String Read FUserID Write FUserID;
+  end;
+  TRestIOClass = Class of TRestIO;
+
+
+  { TStreamerDef }
+
+  TStreamerDef = Class (TCollectionItem)
+  private
+    FClass: TRestStreamerClass;
+    FName: String;
+  Public
+    Property MyClass : TRestStreamerClass Read FClass Write FClass;
+    Property MyName : String Read FName Write Fname;
+  end;
+
+  { TStreamerDefList }
+
+  TStreamerDefList = Class(TCollection)
+  private
+    function GetD(aIndex : integer): TStreamerDef;
+  Public
+    Function IndexOfStreamer(const aName : string) : Integer;
+    Function IndexOfStreamerContentType(const aContentType : string) : Integer;
+    Property Defs[aIndex : integer] : TStreamerDef Read GetD; default;
+  end;
+
+  { TStreamerFactory }
+  TRestStreamerType = (rstInput,rstOutput);
+
+  TStreamerFactory = Class (TObject)
+  Private
+    class var FGlobal : TStreamerFactory;
+  Private
+    FDefs : Array[TRestStreamerType] of TStreamerDefList;
+  Protected
+    Function FindDefByName(aType : TRestStreamerType; aName : String) : TStreamerDef;
+    Function FindDefByContentType(aType : TRestStreamerType; aContentType : String) : TStreamerDef;
+    Function IndexOfStreamer(aType : TRestStreamerType; const aName : string) : Integer;
+    Function IndexOfStreamerContentType(aType : TRestStreamerType; const aContentType : string) : Integer;
+    Procedure RegisterStreamer(aType : TRestStreamerType; Const aName : String; aClass : TRestStreamerClass);
+    Procedure UnRegisterStreamer(aType : TRestStreamerType; Const aName : String);
+  Public
+    Constructor Create;
+    Destructor Destroy; override;
+    Class Function Instance : TStreamerFactory;
+    Class Procedure GetStreamerList(aList : TStrings; atype : TRestStreamerType);
+    Procedure GetStreamerDefNames(aList : TStrings; atype : TRestStreamerType);
+    Function FindStreamerByName(aType : TRestStreamerType; const aName : string) : TStreamerDef;
+    Function FindStreamerByContentType(aType : TRestStreamerType; const aContentType : string) : TStreamerDef;
+  end;
+
+implementation
+
+uses base64, dateutils, sqldbrestconst;
+
+Const
+
+  DefaultPropertyNames :  Array[TRestStringProperty] of UTF8String = (
+    ISODateFormat,     { rpDateFormat }
+    ISODateTimeFormat, { rpDateTimeFormat }
+    ISOTimeFormat,     { rpTimeFormat }
+    'data',            { rpDataRoot}
+    'metaData',        { rpMetaDataRoot }
+    'error',           { rpErrorRoot }
+    'name',            { rpFieldNameProp }
+    'type',            { rpFieldTypeProp }
+    'format',          { rpFieldDateFormatProp }
+    'maxLen',          { rpFieldMaxLenProp }
+    'humanreadable',   { rpHumanReadable }
+    'fl',              { rpFieldList }
+    'xl',              { rpExcludeFieldList }
+    'Connection',      { rpConnection }
+    'Resource',        { rpResource }
+    'metadata',        { rpIncludeMetadata }
+    'sparse',          { rpSparse }
+    'row',             { rpRowName }
+    'fields',          { rpMetaDataFields }
+    'field',           { rpMetaDataField }
+    'code',            { rpErrorCode }
+    'message',         { rpErrorMessage }
+    '',                { rpFilterEqual }
+    '_lt',             { rpFilterLessThan }
+    '_gt',             { rpFilterGreaterThan }
+    '_lte',            { rpFilterLessThanEqual }
+    '_gte',            { rpFilterGreaterThanEqual }
+    '_null',           { rpFilterIsNull }
+    'limit',           { rpLimit }
+    'offset',          { rpOffset }
+    'sort',            { rpOrderBy }
+    'metadata',        { rpMetadataResourceName }
+    'fmtin',           { rpInputFormat }
+    'fmt',             { rpOutputFormat }
+    'customview',      { rpCustomViewResourceName }
+    'sql',             { rpCustomViewSQLParam }
+    'datapacket'       { rpXMLDocumentRoot}
+  );
+
+{ TStreamerDefList }
+
+function TStreamerDefList.GetD(aIndex : integer): TStreamerDef;
+begin
+  Result:=TStreamerDef(Items[aIndex])
+end;
+
+function TStreamerDefList.IndexOfStreamer(const aName: string): Integer;
+begin
+  Result:=Count-1;
+  While (Result>=0) and Not SameText(GetD(Result).MyName,aName) do
+    Dec(Result);
+end;
+
+function TStreamerDefList.IndexOfStreamerContentType(const aContentType: string): Integer;
+begin
+  Result:=Count-1;
+  While (Result>=0) and Not SameText(GetD(Result).MyClass.GetContentType, aContentType) do
+    Dec(Result);
+end;
+
+{ TStreamerFactory }
+
+function TStreamerFactory.FindDefByName(aType : TRestStreamerType; aName: String): TStreamerDef;
+
+Var
+  Idx : integer;
+
+begin
+  Idx:=FDefs[aType].IndexOfStreamer(aName);
+  if Idx=-1 then
+    Result:=Nil
+  else
+    Result:=FDefs[aType][Idx];
+end;
+
+function TStreamerFactory.FindDefByContentType(aType : TRestStreamerType;  aContentType: String): TStreamerDef;
+Var
+  Idx : integer;
+
+begin
+  Idx:=FDefs[aType].IndexOfStreamerContentType(aContentType);
+  if Idx=-1 then
+    Result:=Nil
+  else
+    Result:=FDefs[aType][Idx];
+end;
+
+procedure TStreamerFactory.RegisterStreamer(aType : TRestStreamerType;  const aName: String; aClass: TRestStreamerClass);
+
+Var
+  D : TStreamerDef;
+
+begin
+  D:=FindDefByName(atype,aName);
+  if D=Nil then
+    begin
+    D:=FDefs[atype].Add as TStreamerDef;
+    D.MyName:=aName;
+    end;
+  D.MyClass:=aClass;
+end;
+
+procedure TStreamerFactory.UnRegisterStreamer(aType : TRestStreamerType;  const aName: String);
+
+begin
+  FindDefByName(aType,aName).Free;
+end;
+
+constructor TStreamerFactory.Create;
+
+Var
+  T : TRestStreamerType;
+
+begin
+  for T in TRestStreamerType do
+    FDefs[T]:=TStreamerDefList.Create(TStreamerDef);
+end;
+
+destructor TStreamerFactory.Destroy;
+
+Var
+  T : TRestStreamerType;
+
+begin
+  for T in TRestStreamerType do
+    FreeAndNil(FDefs[T]);
+  inherited Destroy;
+end;
+
+
+class function TStreamerFactory.Instance: TStreamerFactory;
+begin
+  if FGlobal=Nil then
+    FGlobal:=TStreamerFactory.Create;
+  Result:=FGlobal;
+end;
+
+class procedure TStreamerFactory.GetStreamerList(aList: TStrings;
+  atype: TRestStreamerType);
+begin
+  TStreamerFactory.Instance.GetStreamerDefNames(aList,aType);
+end;
+
+procedure TStreamerFactory.GetStreamerDefNames(aList: TStrings; atype: TRestStreamerType);
+
+var
+  I : Integer;
+begin
+  aList.Clear;
+  For I:=0 to FDefs[aType].Count-1 do
+    aList.Add(FDefs[aType][I].MyName);
+end;
+
+function TStreamerFactory.IndexOfStreamer(aType : TRestStreamerType; const aName: string): Integer;
+begin
+  Result:=FDefs[aType].IndexOfStreamer(aName);
+end;
+
+
+function TStreamerFactory.IndexOfStreamerContentType(aType : TRestStreamerType; const aContentType: string): Integer;
+begin
+  Result:=FDefs[aType].IndexOfStreamerContentType(aContentType);
+end;
+
+
+function TStreamerFactory.FindStreamerByName(aType : TRestStreamerType; const aName: string): TStreamerDef;
+
+begin
+  Result:=FindDefByName(aType,aName);
+end;
+
+function TStreamerFactory.FindStreamerByContentType(aType : TRestStreamerType; const aContentType: string): TStreamerDef;
+begin
+  Result:=FindDefByContentType(aType,aContentType);
+end;
+
+
+
+{ TRestStringsConfig }
+
+function TRestStringsConfig.GetRestPropName(AIndex: Integer): UTF8String;
+begin
+  Result:=FValues[TRestStringProperty(AIndex)];
+  if (Result='') then
+    Result:=DefaultPropertyNames[TRestStringProperty(AIndex)]
+end;
+
+procedure TRestStringsConfig.SetRestPropName(AIndex: Integer; AValue: UTF8String);
+begin
+  FValues[TRestStringProperty(AIndex)]:=aValue;
+end;
+
+class function TRestStringsConfig.GetDefaultString(aString: TRestStringProperty): UTF8String;
+begin
+  Result:=DefaultPropertyNames[aString]
+end;
+
+function TRestStringsConfig.GetRestString(aString: TRestStringProperty): UTF8String;
+begin
+  Result:=FValues[aString];
+  if (Result='') then
+    Result:=GetDefaultString(aString);
+end;
+
+procedure TRestStringsConfig.SetRestString(aString: TRestStringProperty; AValue: UTF8String);
+begin
+  FValues[AString]:=aValue;
+end;
+
+procedure TRestStringsConfig.Assign(aSource: TPersistent);
+Var
+  R : TRestStringsConfig;
+  S : TRestStringProperty;
+
+begin
+  if (aSource is TRestStringsConfig) then
+    begin
+    R:=aSource as TRestStringsConfig;
+    For S in TRestStringProperty do
+      FValues[S]:=R.FValues[S];
+    end;
+  inherited Assign(aSource);
+end;
+
+{ TRestOutputStreamer }
+
+procedure TRestOutputStreamer.SetOutputOptions(AValue: TRestOutputOptions);
+begin
+  if FOutputOptions=AValue then Exit;
+  FOutputOptions:=AValue;
+end;
+
+procedure TRestOutputStreamer.CreateErrorContent(aCode: Integer;
+  const Fmt: String; const Args: array of const);
+
+Var
+  S : String;
+
+begin
+  Try
+    S:=Format(Fmt,Args);
+  except
+    On E : Exception do
+      begin
+      S:=Format('Error formatting string "%s" with %d arguments. Original code: %d',[Fmt,Length(Args),aCode]);
+      aCode:=500;
+      end;
+  end;
+  CreateErrorContent(aCode,S);
+end;
+
+function TRestOutputStreamer.HasOption(aOption: TRestOutputOption): Boolean;
+begin
+  Result:=aOption in OutputOptions;
+end;
+
+
+Function TRestOutputStreamer.FieldToBase64(F : TField) : UTF8String;
+
+var
+  BF : TBlobField absolute F;
+  Src : TStream;
+  Dest : TStringStream;
+  E : TBase64EncodingStream;
+
+begin
+  Src:=Nil;
+  Dest:=nil;
+  E:=Nil;
+  Try
+    if f is TBlobField then
+      begin
+      Src:=TMemoryStream.Create;
+      Src.Size:=BF.DataSize;
+      BF.SaveToStream(Src);
+      end
+    else
+      Src:=TStringStream.Create(F.AsString);
+    Src.Position:=0;
+    Dest:=TStringStream.Create(''{,CP_UTF8});
+    E:=TBase64EncodingStream.Create(Dest);
+    E.CopyFrom(Src,0);
+    FreeAndNil(E); // Will flush
+    Result:=Dest.DataString;
+  Finally
+    Src.Free;
+    Dest.Free;
+  end;
+end;
+
+
+{ TRestStreamer }
+
+constructor TRestStreamer.Create(aStream: TStream; aStrings: TRestStringsConfig; aOnGetVar: TRestGetVariableEvent);
+begin
+  FStream:=aStream;
+  FOnGetVar:=aOnGetVar;
+  FStrings:=aStrings;
+end;
+
+function TRestStreamer.GetString(aString: TRestStringProperty): UTF8String;
+begin
+  If Assigned(FStrings) then
+    Result:=FStrings.GetRestString(aString)
+  else
+    Result:=DefaultPropertyNames[aString];
+end;
+
+
+function TRestStreamer.GetVariable(const aName: UTF8String): UTF8String;
+begin
+  Result:='';
+  if Assigned(FOnGetVar) then
+     FOnGetVar(Self,aName,Result);
+end;
+
+Class function TRestStreamer.GetContentType: String;
+begin
+  Result:='text/html';
+end;
+
+class procedure TRestInputStreamer.RegisterStreamer(const aName: String);
+begin
+  TStreamerFactory.Instance.RegisterStreamer(rstInput,aName,Self)
+end;
+
+class procedure TRestInputStreamer.UnRegisterStreamer(const aName: String);
+begin
+  TStreamerFactory.Instance.UnRegisterStreamer(rstInput,aName);
+end;
+
+class procedure TRestOutputStreamer.RegisterStreamer(const aName: String);
+begin
+  TStreamerFactory.Instance.RegisterStreamer(rstOutput,aName,Self)
+end;
+
+class procedure TRestOutPutStreamer.UnRegisterStreamer(const aName: String);
+begin
+  TStreamerFactory.Instance.UnRegisterStreamer(rstOutput,aName)
+end;
+
+function TRestOutputStreamer.RequireMetadata: Boolean;
+begin
+  Result:=False;
+end;
+
+function TRestOutputStreamer.FieldToString(aFieldType : TRestFieldType; F: TField): UTF8string;
+begin
+  Case aFieldType of
+    rftInteger : Result:=F.AsString;
+    rftLargeInt : Result:=F.AsString;
+    rftFloat : Result:=F.AsString;
+    rftDate : Result:=FormatDateTime(GetString(rpDateFormat),DateOf(F.AsDateTime));
+    rftTime : Result:=FormatDateTime(GetString(rpTimeFormat),TimeOf(F.AsDateTime));
+    rftDateTime : Result:=FormatDateTime(GetString(rpDateTimeFormat),F.AsDateTime);
+    rftString : Result:=F.AsString;
+    rftBoolean : Result:=BoolToStr(F.AsBoolean,'true','false');
+    rftBlob : Result:=FieldToBase64(F);
+  end;
+end;
+
+{ TRestIO }
+
+procedure TRestIO.SetIO(aInput: TRestInputStreamer; aOutput: TRestOutputStreamer);
+begin
+  Finput:=aInput;
+  Finput.FOnGetVar:=@DoGetVariable;
+  Foutput:=aOutput;
+  FOutput.FOnGetVar:=@DoGetVariable;
+end;
+
+procedure TRestIO.SetConn(aConn: TSQLConnection; ATrans: TSQLTransaction);
+begin
+  FConn:=aConn;
+  FTrans:=aTrans;
+end;
+
+procedure TRestIO.SetResource(aResource: TSQLDBRestResource);
+begin
+  Fresource:=AResource;
+end;
+
+procedure TRestIO.SetOperation(aOperation: TRestOperation);
+begin
+  FOperation:=aOperation;
+end;
+
+procedure TRestIO.SetRestStrings(aValue: TRestStringsConfig);
+begin
+  FRestStrings:=aValue;
+end;
+
+procedure TRestIO.DoGetVariable(Sender: TObject; const aName: UTF8String; out
+  aVal: UTF8String);
+begin
+  GetVariable(aName,aVal);
+end;
+
+constructor TRestIO.Create(aRequest: TRequest; aResponse: TResponse);
+begin
+  FRequest:=aRequest;
+  FResponse:=aResponse;
+  FContentStream:=TStringStream.Create(aRequest.Content);
+end;
+
+destructor TRestIO.Destroy;
+begin
+  if Assigned(FInput) then
+    Finput.FOnGetVar:=Nil;
+  if Assigned(Foutput) then
+  FOutput.FOnGetVar:=Nil;
+  FreeAndNil(FContentStream) ;
+  FreeAndNil(Finput);
+  FreeAndNil(Foutput);
+  inherited Destroy;
+end;
+
+function TRestIO.GetVariable(const aName: UTF8String; out aVal: UTF8String;
+  AllowedSources: TVAriableSources): TVariableSource;
+
+  Function FindInList(aSource : TVariableSource;L : TStrings) : Boolean;
+
+  Var
+    I : Integer;
+    N,V : String;
+  begin
+    Result:=(aSource in AllowedSources);
+    if Result then
+      begin
+      I:=L.IndexOfName(aName);
+      Result:=I<>-1;
+      if Result then
+        begin
+        L.GetNameValue(I,N,V);
+        aVal:=V;
+        GetVariable:=aSource;
+        end;
+      end;
+  end;
+
+begin
+  Result:=vsNone;
+  With Request do
+    if not FIndInList(vsQuery,QueryFields) then
+      if not FindInList(vsContent,ContentFields) then
+        begin
+        aVal:=RouteParams[aName];
+        if (aVal<>'') then
+          result:=vsRoute
+        else
+          FindInList(vsHeader,CustomHeaders);
+        end;
+end;
+
+function TRestIO.GetFilterVariable(const aName: UTF8String; AFilter: TRestFieldFilter;out aValue: UTF8String) : TVariableSource;
+
+Const
+  FilterStrings : Array[TRestFieldFilter] of TRestStringProperty =
+   (rpFilterEqual,rpFilterLessThan,rpFilterGreaterThan,rpFilterLessThanEqual,rpFilterGreaterThanEqual,rpFilterIsNull);
+
+begin
+  aValue:='';
+  Result:=GetVariable(aName+FRestStrings.GetRestString(FilterStrings[aFilter]),aValue,[vsQuery]);
+end;
+
+Class function TRestIO.StrToNullBoolean(S: String; Strict: Boolean): TNullBoolean;
+
+begin
+  result:=nbNone;
+  s:=lowercase(s);
+  if (s<>'') then
+    if (s='1') or (s='t') or (s='true') or (s='y') then
+      Result:=nbTrue
+    else
+      if (s='0') or (s='f') or (s='false') or (s='n') then
+        Result:=nbFalse
+      else if not Strict then
+        Result:=nbNone
+      else
+        Raise EConvertError.CreateFmt('Not a correct boolean value: "%s"',[S])
+end;
+
+function TRestIO.GetBooleanVar(const aName: UTF8String; aStrict : Boolean = False): TNullBoolean;
+
+Var
+  S : UTF8String;
+
+begin
+  result:=nbNone;
+  if GetVariable(aName,S)=vsNone then
+    Result:=nbNone
+  else
+    Result:=StrToNullBoolean(S,aStrict);
+end;
+
+Function TRestIO.GetRequestOutputOptions(aDefault : TRestOutputOptions) : TRestOutputOptions;
+
+  Procedure CheckParam(aName : String; aOption: TRestOutputOption);
+  begin
+    Case GetBooleanVar(aName) of
+     nbFalse : Exclude(Result,aOption);
+     nbTrue : Include(Result,aOption);
+    else
+     // nbNull: keep default
+    end
+  end;
+
+begin
+  Result:=aDefault;
+  CheckParam(FRestStrings.GetRestString(rpHumanReadable),ooHumanReadable);
+  CheckParam(FRestStrings.GetRestString(rpSparse),ooSparse);
+  CheckParam(FRestStrings.GetRestString(rpIncludeMetadata),ooMetadata);
+end;
+
+function TRestIO.GetLimitOffset(aEnforceLimit : Int64; out aLimit, aOffset: Int64): boolean;
+
+Var
+  P,S : UTF8String;
+
+begin
+  aLimit:=0;
+  aOffset:=0;
+  P:=RestStrings.GetRestString(rpLimit);
+  Result:=GetVariable(P,S,[vsQuery])<>vsNone;
+  if Not Result then
+    Exit;
+  if (S<>'') and not TryStrToInt64(S,aLimit) then
+    Raise ESQLDBRest.CreateFmt(400,SErrInvalidParam,[P]);
+  P:=RestStrings.GetRestString(rpOffset);
+  if GetVariable(P,S,[vsQuery])<>vsNone then
+    if (S<>'') and not TryStrToInt64(S,aOffset) then
+      Raise ESQLDBRest.CreateFmt(400,SErrInvalidParam,[P]);
+  if (aEnforceLimit>0) and (aLimit>aEnforceLimit) then
+    aLimit:=aEnforceLimit;
+end;
+
+procedure TRestIO.CreateErrorResponse;
+begin
+  RestOutput.CreateErrorContent(Response.Code,Response.CodeText);
+end;
+
+finalization
+  FreeAndNil(TStreamerFactory.Fglobal);
+end.
+

packages/fcl-web/src/restbridge/sqldbrestjson.pp

@@ -0,0 +1,257 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2019 by the Free Pascal development team
+
+    SQLDB REST bridge JSON input/output.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit sqldbrestjson;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpjson, db, sqldbrestio, sqldbrestschema;
+
+Type
+  { TJSONInputStreamer }
+
+  TJSONInputStreamer = Class(TRestInputStreamer)
+  private
+    FJSON: TJSONData;
+  Protected
+    Property JSON : TJSONData Read FJSON;
+  Public
+    Destructor Destroy; override;
+    Function SelectObject(aIndex : Integer) : Boolean; override;
+    function GetContentField(aName: UTF8string): TJSONData; override;
+    procedure InitStreaming; override;
+  end;
+
+  { TJSONOutputStreamer }
+  TJSONOutputStreamer = Class(TRestOutputStreamer)
+  Private
+    FJSON : TJSONObject;
+    FData : TJSONArray;
+    FRow: TJSONData;
+  Public
+    procedure EndData; override;
+    procedure EndRow; override;
+    procedure FinalizeOutput; override;
+    procedure StartData; override;
+    procedure StartRow; override;
+    // Return Nil for null field.
+    function FieldToJSON(aPair: TRestFieldPair): TJSONData; virtual;
+    procedure WriteField(aPair: TRestFieldPair); override;
+    procedure WriteMetadata(aFieldList: TRestFieldPairArray); override;
+    Procedure CreateErrorContent(aCode : Integer; Const aMessage: String); override;
+    Property JSON : TJSONObject Read FJSON;
+    Property Data : TJSONArray Read FData;
+    Property Row : TJSONData Read FRow;
+  Public
+    Destructor Destroy; override;
+    Class Function GetContentType: String; override;
+    procedure InitStreaming; override;
+  end;
+
+implementation
+
+uses DateUtils, sqldbrestconst;
+
+{ TJSONInputStreamer }
+
+procedure TJSONInputStreamer.InitStreaming;
+
+Var
+  Msg : String;
+
+begin
+  FreeAndNil(FJSON);
+  if (Stream.Size>0) then
+    begin
+    try
+      FJSON:=GetJSON(Stream);
+    except
+      On E : Exception do
+        begin
+        Msg:=E.Message;
+        FJSON:=Nil;
+        end;
+    end;
+    if (FJSON=Nil)  then
+      Raise ESQLDBRest.CreateFmt(400,'Invalid JSON input: %s',[Msg]);
+    end;
+end;
+
+destructor TJSONInputStreamer.Destroy;
+begin
+  FreeAndNil(FJSON);
+  inherited Destroy;
+end;
+
+function TJSONInputStreamer.SelectObject(aIndex: Integer): Boolean;
+begin
+  Result:=(aIndex=0) and (FJSON<>Nil)  and (FJSON is TJSONObject)
+end;
+
+function TJSONInputStreamer.GetContentField(aName: UTF8string): TJSONData;
+
+Var
+  D : TJSONData;
+
+begin
+  D:=(FJSON as TJSONObject).Find(aName);
+  if D<>nil then
+    Result:=D.Clone
+  else
+    Result:=nil;
+end;
+
+{ TJSONOutputStreamer }
+
+
+procedure TJSONOutputStreamer.EndData;
+begin
+  FData:=Nil;
+end;
+
+procedure TJSONOutputStreamer.EndRow;
+begin
+  FRow:=Nil;
+end;
+
+procedure TJSONOutputStreamer.FinalizeOutput;
+
+Var
+  S : TJSONStringType;
+begin
+  if ooHumanReadable in OutputOptions then
+    S:=FJSON.FormatJSON()
+  else
+    S:=FJSON.AsJSON;
+  Stream.WriteBuffer(S[1],Length(S)*SizeOf(TJSONCharType));
+  FreeAndNil(FJSON);
+end;
+
+procedure TJSONOutputStreamer.StartData;
+begin
+  FData:=TJSONArray.Create;
+  FJSON.Add(GetString(rpDataRoot),FData);
+end;
+
+procedure TJSONOutputStreamer.StartRow;
+begin
+  if (FRow<>Nil) then
+    Raise ESQLDBRest.Create(500,SErrDoubleRowStart);
+  FRow:=TJSONObject.Create;
+  FData.Add(FRow);
+end;
+
+
+Function TJSONOutputStreamer.FieldToJSON(aPair: TRestFieldPair) : TJSONData;
+
+Var
+  F : TField;
+
+begin
+  Result:=Nil;
+  F:=aPair.DBField;;
+  If (aPair.RestField.FieldType=rftUnknown) then
+    raise ESQLDBRest.CreateFmt(500,SErrUnsupportedRestFieldType, [aPair.RestField.PublicName]);
+  If (F.IsNull) then
+    Exit;
+    Case aPair.RestField.FieldType of
+      rftInteger : Result:=TJSONIntegerNumber.Create(F.AsInteger);
+      rftLargeInt : Result:=TJSONInt64Number.Create(F.AsLargeInt);
+      rftFloat : Result:=TJSONFloatNumber.Create(F.AsFloat);
+      rftDate : Result:=TJSONString.Create(FormatDateTime(GetString(rpDateFormat),DateOf(F.AsDateTime)));
+      rftTime : Result:=TJSONString.Create(FormatDateTime(GetString(rpTimeFormat),TimeOf(F.AsDateTime)));
+      rftDateTime : Result:=TJSONString.Create(FormatDateTime(GetString(rpDateTimeFormat),F.AsDateTime));
+      rftString : Result:=TJSONString.Create(F.AsString);
+      rftBoolean : Result:=TJSONBoolean.Create(F.AsBoolean);
+      rftBlob : Result:=TJSONString.Create(FieldToBase64(F));
+    end;
+end;
+
+procedure TJSONOutputStreamer.WriteField(aPair: TRestFieldPair);
+
+Var
+  D : TJSONData;
+  N : UTF8String;
+
+begin
+  N:=aPair.RestField.PublicName;
+  if FRow=Nil then
+    Raise ESQLDBRest.CreateFmt(500,SErrFieldWithoutRow,[N]);
+  D:=FieldToJSON(aPair);
+  if (D=Nil) and ((not HasOption(ooSparse)) or (FRow is TJSONArray)) then
+    D:=TJSONNull.Create;
+  if D<>Nil then
+    If FRow is TJSONArray then
+      TJSONArray(FRow).Add(D)
+    else if FRow is TJSONObject then
+      TJSONObject(FRow).Add(N,D);
+end;
+
+procedure TJSONOutputStreamer.WriteMetadata(aFieldList: TRestFieldPairArray);
+
+Var
+  A : TJSONArray;
+  F : TJSONObject;
+  P : TREstFieldPair;
+
+begin
+  A:=TJSONArray.Create;
+  FJSON.Add(GetString(rpMetaDataRoot),TJSOnObject.Create([GetString(rpMetaDataFields),A]));
+  For P in aFieldList do
+    begin
+    F:=TJSONObject.Create([GetString(rpFieldNameProp),P.RestField.PublicName,GetString(rpFieldTypeProp),typenames[P.RestField.FieldType]]);
+    A.Add(F);
+    Case P.RestField.FieldType of
+      rftDate : F.Add(GetString(rpFieldDateFormatProp),GetString(rpDateFormat));
+      rftTime : F.Add(GetString(rpFieldDateFormatProp),GetString(rpTimeFormat));
+      rftDateTime : F.Add(GetString(rpFieldDateFormatProp),GetString(rpDateTimeFormat));
+      rftString : F.Add(GetString(rpFieldMaxLenProp),P.DBField.Size);
+    end;
+    end;
+end;
+
+Class function TJSONOutputStreamer.GetContentType: String;
+begin
+  Result:='application/json';
+end;
+
+procedure TJSONOutputStreamer.CreateErrorContent(aCode: Integer; const aMessage: String);
+
+Var
+  ErrorObj : TJSONObject;
+
+begin
+  ErrorObj:=TJSONObject.Create([GetString(rpErrorCode),aCode,GetString(rpErrorMessage),aMessage]);
+  FJSON.Add(GetString(rpErrorRoot),ErrorObj);
+end;
+
+destructor TJSONOutputStreamer.Destroy;
+begin
+  FreeAndNil(FJSON);
+  inherited Destroy;
+end;
+
+procedure TJSONOutputStreamer.InitStreaming;
+begin
+  FJSON:=TJSONObject.Create;
+end;
+
+initialization
+  TJSONInputStreamer.RegisterStreamer('json');
+  TJSONOutputStreamer.RegisterStreamer('json');
+end.
+

packages/fcl-web/src/restbridge/sqldbrestschema.pp

@@ -0,0 +1,1098 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2019 by the Free Pascal development team
+
+    SQLDB REST bridge : REST Schema.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit sqldbrestschema;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, db, sqldb, fpjson;
+
+Type
+
+  TRestFieldType = (rftUnknown,rftInteger,rftLargeInt,rftFloat,rftDate,rftTime,rftDateTime,rftString,rftBoolean,rftBlob);
+  TRestFieldTypes = set of TRestFieldType;
+
+  TRestFieldOption = (foInKey,foInInsert, foInUpdate,foRequired,foFilter,foOrderBy,foOrderByDesc);
+  TRestFieldOptions = Set of TRestFieldOption;
+
+  TRestFieldFilter = (rfEqual,rfLessThan,rfGreaterThan,rfLessThanEqual,rfGreaterThanEqual,rfNull);
+  TRestFieldFilters = set of TRestFieldFilter;
+
+  TSQLKind = (skSelect,skInsert,skUpdate,skDelete); // Must follow Index used below.
+  TSQLKinds = set of TSQLKind;
+
+  TRestOperation = (roUnknown,roGet,roPost,roPut,roDelete,roOptions,roHead); // add roPatch, roMerge ?
+  TRestOperations = Set of TRestOperation;
+
+  TFieldListKind = (flSelect,flInsert,flInsertParams,flUpdate,flWhereKey,flFilter,flOrderby);
+  TFieldListKinds = set of TFieldListKind;
+
+
+Const
+  AllRestOperations = [Succ(Low(TRestOperation))..High(TRestOperation)];
+  AllFieldFilters = [Low(TRestFieldFilter)..High(TRestFieldFilter)];
+  JSONSchemaRoot = 'schema';
+  JSONResourcesRoot = 'resources';
+  JSONConnectionsRoot = 'connections';
+
+Type
+
+  { ESQLDBRest }
+
+  ESQLDBRest = Class(Exception)
+  private
+    FResponseCode: Integer;
+  Public
+    Constructor Create(aCode : Integer; Const aMessage : String);
+    Constructor CreateFmt(aCode : Integer; Const Fmt : String; COnst Args: Array of const);
+    Property ResponseCode : Integer Read FResponseCode Write FResponseCode;
+  end;
+
+  TRestSQLQuery = Class(TSQLQuery)
+  Public
+    Property TableName;
+  end;
+
+  TSQLDBRestSchema = Class;
+
+
+  { TSQLDBRestField }
+
+  TSQLDBRestField = class(TCollectionItem)
+  private
+    FFieldName: UTF8String;
+    FFieldType: TRestFieldType;
+    FFilters: TRestFieldFilters;
+    fGeneratorName: String;
+    FMaxLen: Integer;
+    FNativeFieldType: TFieldType;
+    FOptions: TRestFieldOptions;
+    FPublicName: UTF8String;
+    function GetPublicName: UTF8String;
+  Protected
+    Function GetDisplayName: string; override;
+  Public
+    Constructor Create(ACollection: TCollection); override;
+    Procedure Assign(Source: TPersistent); override;
+    Function UseInFieldList(aListKind : TFieldListKind) : Boolean; virtual;
+  Published
+    Property FieldName : UTF8String Read FFieldName Write FFieldName;
+    Property PublicName : UTF8String Read GetPublicName Write FPublicName;
+    Property GeneratorName : String Read fGeneratorName Write FGeneratorName;
+    Property FieldType : TRestFieldType Read FFieldType Write FFieldType;
+    Property NativeFieldType : TFieldType Read FNativeFieldType Write FNativeFieldType;
+    Property Options : TRestFieldOptions Read FOptions Write FOptions;
+    Property Filters : TRestFieldFilters Read FFilters Write FFilters default AllFieldFilters;
+    Property MaxLen : Integer Read FMaxLen Write FMaxLen;
+  end;
+  TSQLDBRestFieldClass = Class of TSQLDBRestField;
+  TSQLDBRestFieldArray = Array of TSQLDBRestField;
+
+  TRestFieldPair = Record
+    DBField : TField;
+    RestField :TSQLDBRestField;
+  end;
+  TRestFieldPairArray = Array of TRestFieldPair;
+
+  TRestFieldOrderPair = Record
+    RestField :TSQLDBRestField;
+    Desc : Boolean;
+  end;
+  TRestFieldOrderPairArray = Array of TRestFieldOrderPair;
+
+  { TSQLDBRestFieldList }
+
+  TSQLDBRestFieldList = class(TCollection)
+  private
+    function GetFields(aIndex : Integer): TSQLDBRestField;
+    procedure SetFields(aIndex : Integer; AValue: TSQLDBRestField);
+  Public
+    Function AddField(Const aFieldName : UTF8String; aFieldType : TRestFieldType; aOptions : TRestFieldOptions) : TSQLDBRestField;
+    function indexOfFieldName(const aFieldName: UTF8String): Integer;
+    Function FindByFieldName(const aFieldName: UTF8String):TSQLDBRestField;
+    function indexOfPublicName(const aPublicName: UTF8String): Integer;
+    Function FindByPublicName(const aFieldName: UTF8String):TSQLDBRestField;
+    Property Fields[aIndex : Integer] : TSQLDBRestField read GetFields write SetFields; default;
+  end;
+  TSQLDBRestFieldListClass = Class of TSQLDBRestFieldList;
+
+  { TSQLDBRestResource }
+  TSQLDBRestGetDatasetEvent = Procedure (aSender : TObject; aFieldList : TRestFieldPairArray; aOrderBy : TRestFieldOrderPairArray; aLimit, aOffset : Int64; Var aDataset : TDataset) of object;
+  TSQLDBRestCheckParamsEvent = Procedure (aSender : TObject; aOperation : TRestOperation; Params : TParams) of object;
+  TSQLDBRestAllowRecordEvent = Procedure (aSender : TObject; aDataSet : TDataset; var allowRecord : Boolean) of object;
+  TProcessIdentifier = Function (const S: UTF8String): UTF8String of object;
+
+  TSQLDBRestResource = class(TCollectionItem)
+  private
+    FAllowedOperations: TRestOperations;
+    FConnectionName: UTF8String;
+    FEnabled: Boolean;
+    FFields: TSQLDBRestFieldList;
+    FInMetadata: Boolean;
+    FOnAllowRecord: TSQLDBRestAllowRecordEvent;
+    FOnCheckParams: TSQLDBRestCheckParamsEvent;
+    FOnGetDataset: TSQLDBRestGetDatasetEvent;
+    FResourceName: UTF8String;
+    FTableName: UTF8String;
+    FSQL : Array[TSQLKind] of TStrings;
+    function GetResourceName: UTF8String;
+    function GetSQL(AIndex: Integer): TStrings;
+    function GetSQLTyped(aKind : TSQLKind): TStrings;
+    procedure SetFields(AValue: TSQLDBRestFieldList);
+    procedure SetSQL(AIndex: Integer; AValue: TStrings);
+  Protected
+    Function GetDisplayName: string; override;
+  Public
+    Class var
+      DefaultFieldListClass : TSQLDBRestFieldListClass;
+      DefaultFieldClass: TSQLDBRestFieldClass;
+    Class function CreateFieldList : TSQLDBRestFieldList; virtual;
+    Class function FieldTypeToRestFieldType(aFieldType: TFieldType): TRestFieldType; virtual;
+  Public
+    Constructor Create(ACollection: TCollection); override;
+    Destructor Destroy; override;
+    Procedure CheckParams(aOperation : TRestoperation; P : TParams);
+    Function GetDataset(aFieldList : TRestFieldPairArray; aOrderBy : TRestFieldOrderPairArray; aLimit, aOffset : Int64) : TDataset;
+    Function GetSchema : TSQLDBRestSchema;
+    function GenerateDefaultSQL(aKind: TSQLKind): UTF8String; virtual;
+    Procedure Assign(Source: TPersistent); override;
+    Function AllowRecord(aDataset : TDataset) : Boolean;
+    Function GetHTTPAllow : String; virtual;
+    function GetFieldList(aListKind: TFieldListKind): UTF8String;
+    function GetFieldArray(aListKind: TFieldListKind): TSQLDBRestFieldArray;
+    Function GetResolvedSQl(aKind : TSQLKind; Const AWhere : UTF8String; Const aOrderBy : UTF8String = ''; aLimit : UTF8String = '') : UTF8String;
+    Procedure PopulateFieldsFromFieldDefs(Defs : TFieldDefs; aIndexFields : TStringArray; aProcessIdentifier : TProcessIdentifier; aMinFieldOpts : TRestFieldOptions);
+    Property SQL [aKind : TSQLKind] : TStrings Read GetSQLTyped;
+  Published
+    Property Fields : TSQLDBRestFieldList Read FFields Write SetFields;
+    Property Enabled : Boolean Read FEnabled Write FEnabled default true;
+    Property InMetadata : Boolean Read FInMetadata Write FInMetadata default true;
+    Property ConnectionName : UTF8String read FConnectionName Write FConnectionName;
+    Property TableName : UTF8String read FTableName Write FTableName;
+    Property ResourceName : UTF8String read GetResourceName Write FResourceName;
+    Property AllowedOperations : TRestOperations Read FAllowedOperations Write FAllowedOperations;
+    Property SQLSelect : TStrings Index 0 Read GetSQL Write SetSQL;
+    Property SQLInsert : TStrings Index 1 Read GetSQL Write SetSQL;
+    Property SQLUpdate : TStrings Index 2 Read GetSQL Write SetSQL;
+    Property SQLDelete : TStrings Index 3 Read GetSQL Write SetSQL;
+    Property OnGetDataset : TSQLDBRestGetDatasetEvent Read FOnGetDataset Write FOnGetDataset;
+    Property OnCheckParams : TSQLDBRestCheckParamsEvent Read FOnCheckParams Write FOnCheckParams;
+    Property OnAllowRecord : TSQLDBRestAllowRecordEvent Read FOnAllowRecord Write FOnAllowRecord;
+  end;
+
+  { TSQLDBRestResourceList }
+
+  TSQLDBRestResourceList = Class(TOwnedCollection)
+  private
+    function GetResource(aIndex : Integer): TSQLDBRestResource;
+    procedure SetResource(aIndex : Integer; AValue: TSQLDBRestResource);
+  Public
+    Function Schema : TSQLDBRestSchema;
+    Function AddResource(Const aTableName : UTF8String; Const aResourceName : UTF8String) : TSQLDBRestResource;
+    Function indexOfTableName(Const aTableName : UTF8String) : Integer;
+    Function indexOfResourceName(Const aResourceName : UTF8String) : Integer;
+    Function FindResourceByName(Const aResourceName : UTF8String) : TSQLDBRestResource;
+    Function FindResourceByTableName(Const aTableName : UTF8String) : TSQLDBRestResource;
+    Procedure SaveToFile(Const aFileName : UTF8String);
+    Procedure SaveToStream(Const aStream : TStream);
+    function AsJSON(const aPropName: UTF8String=''): TJSONData;
+    Procedure LoadFromFile(Const aFileName : UTF8String);
+    Procedure LoadFromStream(Const aStream : TStream);
+    Procedure FromJSON(aData: TJSONData;const aPropName: UTF8String='');
+    Property Resources[aIndex : Integer] : TSQLDBRestResource read GetResource write SetResource; default;
+  end;
+
+  { TSQLDBRestSchema }
+
+  TSQLDBRestSchema = Class(TComponent)
+  private
+    FConnectionName: UTF8String;
+    FResources: TSQLDBRestResourceList;
+    procedure SetResources(AValue: TSQLDBRestResourceList);
+  Protected
+    function CreateResourceList: TSQLDBRestResourceList; virtual;
+    function GetPrimaryIndexFields(Q: TSQLQuery): TStringArray; virtual;
+    function ProcessIdentifier(const S: UTF8String): UTF8String; virtual;
+  Public
+    Constructor Create(AOwner: TComponent); override;
+    Destructor Destroy; override;
+    Procedure SaveToFile(Const aFileName : UTF8String);
+    Procedure SaveToStream(Const aStream : TStream);
+    function AsJSON(const aPropName: UTF8String=''): TJSONData;
+    Procedure LoadFromFile(Const aFileName : UTF8String);
+    Procedure LoadFromStream(Const aStream : TStream);
+    Procedure FromJSON(aData: TJSONData;const aPropName: UTF8String='');
+    procedure PopulateResourceFields(aConn: TSQLConnection; aRes: TSQLDBRestResource; aMinFieldOpts : TRestFieldOptions = []); virtual;
+    procedure PopulateResources(aConn: TSQLConnection; aTables: array of string; aMinFieldOpts: TRestFieldOptions= []);
+    Procedure PopulateResources(aConn : TSQLConnection; aTables : TStrings = Nil; aMinFieldOpts : TRestFieldOptions = []);
+  Published
+    Property Resources : TSQLDBRestResourceList Read FResources Write SetResources;
+    Property ConnectionName : UTF8String Read FConnectionName Write FConnectionName;
+  end;
+
+  TCustomViewResource = Class(TSQLDBRestResource)
+  end;
+
+Const
+  TypeNames : Array[TRestFieldType] of string = ('?','int','bigint','float','date','time','datetime','string','bool','blob');
+
+implementation
+
+uses strutils, fpjsonrtti,dbconst, sqldbrestconst;
+
+
+{ ESQLDBRest }
+
+constructor ESQLDBRest.Create(aCode: Integer; const aMessage: String);
+begin
+  FResponseCode:=aCode;
+  HelpContext:=aCode;
+  Inherited create(aMessage);
+end;
+
+constructor ESQLDBRest.CreateFmt(aCode: Integer; const Fmt: String;
+  const Args: array of const);
+begin
+  FResponseCode:=aCode;
+  HelpContext:=aCode;
+  Inherited CreateFmt(Fmt,Args);
+end;
+
+
+{ TSQLDBRestSchema }
+
+procedure TSQLDBRestSchema.SetResources(AValue: TSQLDBRestResourceList);
+begin
+  if FResources=AValue then Exit;
+  FResources.Assign(AValue);
+end;
+
+constructor TSQLDBRestSchema.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FResources:=CreateResourceList;
+end;
+
+Function TSQLDBRestSchema.CreateResourceList :  TSQLDBRestResourceList;
+
+begin
+  Result:=TSQLDBRestResourceList.Create(Self,TSQLDBRestResource);
+end;
+
+destructor TSQLDBRestSchema.Destroy;
+begin
+  FreeAndNil(FResources);
+  inherited Destroy;
+end;
+
+procedure TSQLDBRestSchema.SaveToFile(const aFileName: UTF8String);
+Var
+  F : TFileStream;
+
+begin
+  F:=TFileStream.Create(aFileName,fmCreate);
+  try
+    SaveToStream(F);
+  finally
+    F.Free;
+  end;
+end;
+
+procedure TSQLDBRestSchema.SaveToStream(const aStream: TStream);
+
+Var
+  D : TJSONData;
+  S : TJSONStringType;
+
+begin
+  D:=asJSON(JSONSchemaRoot);
+  try
+    S:=D.FormatJSON();
+  finally
+    D.Free;
+  end;
+  aStream.WriteBuffer(S[1],Length(S)*SizeOf(TJSONCharType));
+end;
+
+function TSQLDBRestSchema.AsJSON(const aPropName: UTF8String): TJSONData;
+
+begin
+  Result:=TJSONObject.Create([JSONResourcesRoot,Resources.AsJSON(),'connectionName',ConnectionName]);
+  if (aPropName<>'') then
+    Result:=TJSONObject.Create([aPropName,Result]);
+end;
+
+procedure TSQLDBRestSchema.LoadFromFile(const aFileName: UTF8String);
+Var
+  F : TFileStream;
+
+begin
+  F:=TFileStream.Create(aFileName,fmOpenRead or fmShareDenyWrite);
+  try
+    LoadFromStream(F);
+  finally
+    F.Free;
+  end;
+end;
+
+procedure TSQLDBRestSchema.LoadFromStream(const aStream: TStream);
+Var
+  D : TJSONData;
+
+begin
+  D:=GetJSON(aStream);
+  try
+    FromJSON(D,JSONSchemaRoot);
+  finally
+    D.Free;
+  end;
+end;
+
+procedure TSQLDBRestSchema.FromJSON(aData: TJSONData; const aPropName: UTF8String);
+
+Var
+  J : TJSONObject;
+
+begin
+  J:=aData as TJSONObject;
+  Resources.FromJSON(J,JSONResourcesRoot);
+  ConnectionName:=J.Get(aPropName,'');
+end;
+
+Function TSQLDBRestSchema.ProcessIdentifier(Const S : UTF8String) : UTF8String;
+
+begin
+  Result:=S;
+end;
+
+
+Function TSQLDBRestSchema.GetPrimaryIndexFields(Q : TSQLQuery) : TStringArray;
+
+Var
+  C,I : Integer;
+  Fields : UTF8String;
+
+
+begin
+  Result:=Default(TStringArray);
+  Q.ServerIndexDefs.Update;
+  I:=0;
+  Fields:='';
+  With Q.ServerIndexDefs do
+    While (Fields='') and (i<Count) do
+      begin
+      if (ixPrimary in Items[i].Options) then
+        Fields:=Items[i].Fields;
+      Inc(I);
+      end;
+  C:=WordCount(Fields,[';',' ']);
+  SetLength(Result,C);
+  For I:=1 to C do
+    Result[I-1]:=ExtractWord(I,Fields,[';',' ']);
+end;
+
+procedure TSQLDBRestSchema.PopulateResourceFields(aConn : TSQLConnection; aRes : TSQLDBRestResource; aMinFieldOpts : TRestFieldOptions = []);
+
+Var
+  Q : TRestSQLQuery;
+  IndexFields : TStringArray;
+
+
+begin
+  IndexFields:=Default(TStringArray);
+  Q:=TRestSQLQuery.Create(Self);
+  try
+    Q.Database:=aConn;
+    Q.ParseSQL:=True; // we want the table name
+    if (aRes.SQLSelect.Count=0) then
+      Q.SQL.Text:='SELECT * FROM '+aRes.TableName+' WHERE (1=0)' // Not very efficient :(
+    else
+      Q.SQL.Text:=aRes.GetResolvedSQL(skSelect,'(1=0)','');
+    Q.TableName:=aRes.TableName;
+    Q.UniDirectional:=True;
+    Q.UsePrimaryKeyAsKey:=False;
+    Q.Open;
+    if (Q.TableName<>'') then
+      IndexFields:=GetPrimaryIndexFields(Q);
+    aRes.PopulateFieldsFromFieldDefs(Q.FieldDefs,IndexFields,@ProcessIdentifier,aMinFieldOpts)
+  finally
+    Q.Free;
+  end;
+end;
+
+procedure TSQLDBRestSchema.PopulateResources(aConn: TSQLConnection; aTables : Array of string; aMinFieldOpts : TRestFieldOptions = []);
+
+Var
+  L : TStringList;
+  S : String;
+
+begin
+  L:=TStringList.Create;
+  try
+    L.Capacity:=Length(aTables);
+    For S in aTables do
+      L.Add(S);
+    L.Sorted:=True;
+    PopulateResources(aConn,L,aMinFieldOpts);
+  finally
+    l.Free;
+  end;
+end;
+
+procedure TSQLDBRestSchema.PopulateResources(aConn: TSQLConnection; aTables : TStrings = Nil; aMinFieldOpts : TRestFieldOptions = []);
+
+Var
+  L : TStrings;
+  S,N : UTF8String;
+  R : TSQLDBRestResource;
+
+
+begin
+  L:=TStringList.Create;
+  try
+    aConn.Connected:=True;
+    aConn.GetTableNames(L);
+    For S in L do
+      begin
+      N:=ProcessIdentifier(S);
+      if SameStr(N,S) then // No SameText, Allow to change case
+        N:='';
+      if (aTables=Nil) or (aTables.IndexOf(S)=-1) then
+        begin
+        R:=Resources.AddResource(S,N);
+        PopulateResourceFields(aConn,R,aMinFieldOpts);
+        end;
+      end;
+  finally
+    L.Free;
+  end;
+end;
+
+{ TSQLDBRestResourceList }
+
+function TSQLDBRestResourceList.GetResource(aIndex : Integer): TSQLDBRestResource;
+begin
+  Result:=TSQLDBRestResource(Items[aIndex])
+end;
+
+procedure TSQLDBRestResourceList.SetResource(aIndex : Integer; AValue: TSQLDBRestResource);
+begin
+  Items[aIndex]:=aValue;
+end;
+
+function TSQLDBRestResourceList.Schema: TSQLDBRestSchema;
+begin
+  If (Owner is  TSQLDBRestSchema) then
+    Result:=Owner as  TSQLDBRestSchema
+  else
+    Result:=Nil;
+end;
+
+function TSQLDBRestResourceList.AddResource(const aTableName: UTF8String; const aResourceName: UTF8String): TSQLDBRestResource;
+
+Var
+  N : UTF8String;
+
+begin
+  N:=aResourceName;
+  if N='' then
+    N:=aTableName;
+  if (N='') then
+    Raise ESQLDBRest.Create(500,SErrResourceNameEmpty);
+  if indexOfResourceName(N)<>-1 then
+    Raise ESQLDBRest.CreateFmt(500,SErrDuplicateResource,[N]);
+  Result:=add as TSQLDBRestResource;
+  Result.TableName:=aTableName;
+  Result.ResourceName:=aResourceName;
+end;
+
+function TSQLDBRestResourceList.indexOfTableName(const aTableName: UTF8String): Integer;
+begin
+  Result:=Count-1;
+  While (Result>=0) and not SameText(aTableName,GetResource(Result).TableName) do
+    Dec(Result);
+end;
+
+function TSQLDBRestResourceList.indexOfResourceName(const aResourceName: UTF8String): Integer;
+
+begin
+  Result:=Count-1;
+  While (Result>=0) and not SameText(aResourceName,GetResource(Result).ResourceName) do
+    Dec(Result);
+end;
+
+function TSQLDBRestResourceList.FindResourceByName(const aResourceName: UTF8String): TSQLDBRestResource;
+
+Var
+  Idx : Integer;
+
+begin
+  idx:=indexOfResourceName(aResourceName);
+  if Idx=-1 then
+    Result:=nil
+  else
+    Result:=GetResource(Idx);
+end;
+
+function TSQLDBRestResourceList.FindResourceByTableName(const aTableName: UTF8String): TSQLDBRestResource;
+Var
+  Idx : Integer;
+
+begin
+  idx:=indexOfTableName(aTableName);
+  if Idx=-1 then
+    Result:=nil
+  else
+    Result:=GetResource(Idx);
+end;
+
+procedure TSQLDBRestResourceList.SaveToFile(const aFileName: UTF8String);
+
+Var
+  F : TFileStream;
+
+begin
+  F:=TFileStream.Create(aFileName,fmCreate);
+  try
+    SaveToStream(F);
+  finally
+    F.Free;
+  end;
+end;
+
+procedure TSQLDBRestResourceList.SaveToStream(const aStream: TStream);
+
+Var
+  D : TJSONData;
+  S : TJSONStringType;
+
+begin
+  D:=asJSON(JSONResourcesRoot);
+  try
+    S:=D.FormatJSON();
+  finally
+    D.Free;
+  end;
+  aStream.WriteBuffer(S[1],Length(S)*SizeOf(TJSONCharType));
+end;
+
+function TSQLDBRestResourceList.AsJSON(const aPropName: UTF8String = ''): TJSONData;
+
+Var
+  S : TJSONStreamer;
+  A : TJSONArray;
+
+begin
+  S:=TJSONStreamer.Create(Nil);
+  try
+    A:=S.StreamCollection(Self);
+  finally
+    S.Free;
+  end;
+  if aPropName='' then
+    Result:=A
+  else
+    Result:=TJSONObject.Create([aPropName,A]);
+end;
+
+procedure TSQLDBRestResourceList.LoadFromFile(const aFileName: UTF8String);
+
+Var
+  F : TFileStream;
+
+begin
+  F:=TFileStream.Create(aFileName,fmOpenRead or fmShareDenyWrite);
+  try
+    LoadFromStream(F);
+  finally
+    F.Free;
+  end;
+end;
+
+procedure TSQLDBRestResourceList.LoadFromStream(const aStream: TStream);
+
+Var
+  D : TJSONData;
+
+begin
+  D:=GetJSON(aStream);
+  try
+    FromJSON(D,JSONResourcesRoot);
+  finally
+    D.Free;
+  end;
+end;
+
+procedure TSQLDBRestResourceList.FromJSON(aData: TJSONData; const aPropName: UTF8String);
+
+Var
+  A : TJSONArray;
+  D : TJSONDestreamer;
+
+begin
+  if (aPropName<>'') then
+    A:=(aData as TJSONObject).Arrays[aPropName]
+  else
+    A:=aData as TJSONArray;
+  D:=TJSONDestreamer.Create(Nil);
+  try
+    Clear;
+    D.JSONToCollection(A,Self);
+  finally
+    D.Free;
+  end;
+end;
+
+{ TSQLDBRestResource }
+
+function TSQLDBRestResource.GetResourceName: UTF8String;
+begin
+  Result:=FResourceName;
+  if Result='' then
+    Result:=FTableName;
+end;
+
+function TSQLDBRestResource.GetSQL(AIndex: Integer): TStrings;
+begin
+  Result:=FSQL[TSQLKind(aIndex)];
+end;
+
+function TSQLDBRestResource.GetSQLTyped(aKind : TSQLKind): TStrings;
+begin
+  Result:=FSQL[aKind];
+end;
+
+procedure TSQLDBRestResource.SetFields(AValue: TSQLDBRestFieldList);
+begin
+  if FFields=AValue then Exit;
+  FFields:=AValue;
+end;
+
+procedure TSQLDBRestResource.SetSQL(AIndex: Integer; AValue: TStrings);
+begin
+  FSQL[TSQLKind(aIndex)].Assign(aValue);
+end;
+
+function TSQLDBRestResource.GetDisplayName: string;
+begin
+  Result:=ResourceName;
+end;
+
+constructor TSQLDBRestResource.Create(ACollection: TCollection);
+
+Var
+  K : TSQLKind;
+
+begin
+  inherited Create(ACollection);
+  FFields:=CreateFieldList;
+  FEnabled:=True;
+  FInMetadata:=True;
+  for K in TSQLKind do
+    FSQL[K]:=TStringList.Create;
+  FAllowedOperations:=AllRestOperations;
+end;
+
+destructor TSQLDBRestResource.Destroy;
+
+Var
+  K : TSQLKind;
+
+begin
+  FreeAndNil(FFields);
+  for K in TSQLKind do
+    FreeAndNil(FSQL[K]);
+  inherited Destroy;
+end;
+
+procedure TSQLDBRestResource.CheckParams(aOperation: TRestoperation; P: TParams);
+begin
+  if Assigned(FOnCheckParams) then
+    FOnCheckParams(Self,aOperation,P);
+end;
+
+function TSQLDBRestResource.GetDataset(aFieldList: TRestFieldPairArray; aOrderBy: TRestFieldOrderPairArray; aLimit, aOffset: Int64): TDataset;
+begin
+  Result:=Nil;
+  If Assigned(FOnGetDataset) then
+    FOnGetDataset(Self,aFieldList,aOrderBy,aLimit,aOffset,Result);
+end;
+
+function TSQLDBRestResource.GetSchema: TSQLDBRestSchema;
+begin
+  If Assigned(Collection) and (Collection is TSQLDBRestResourceList) then
+    Result:=TSQLDBRestResourceList(Collection).Schema
+  else
+    Result:=Nil;
+end;
+
+procedure TSQLDBRestResource.Assign(Source: TPersistent);
+
+Var
+  R : TSQLDBRestResource;
+  K : TSQLKind;
+
+begin
+  if (Source is TSQLDBRestResource) then
+    begin
+    R:=Source as TSQLDBRestResource;
+    for K in TSQLKind do
+      SQL[K].Assign(R.SQL[K]);
+    Fields.Assign(R.Fields);
+    TableName:=R.TableName;
+    FResourceName:=R.FResourceName;
+    ConnectionName:=R.ConnectionName;
+    Enabled:=R.Enabled;
+    InMetadata:=R.InMetadata;
+    end
+  else
+    inherited Assign(Source);
+end;
+
+function TSQLDBRestResource.AllowRecord(aDataset: TDataset): Boolean;
+begin
+  Result:=True;
+  if Assigned(FOnAllowRecord) then
+    FOnAllowRecord(Self,aDataset,Result);
+end;
+
+function TSQLDBRestResource.GetHTTPAllow: String;
+
+  Procedure AddR(s : String);
+
+  begin
+    if (Result<>'') then
+      Result:=Result+', ';
+    Result:=Result+S;
+  end;
+
+Const
+  Methods : Array[TRestOperation] of string = ('','GET','POST','PUT','DELETE','OPTIONS','HEAD');
+
+Var
+  O : TRestOperation;
+
+begin
+  Result:='';
+  For O in TRestOperation do
+    if (O<>roUnknown) and (O in AllowedOperations) then
+      AddR(Methods[O]);
+end;
+
+function TSQLDBRestResource.GetFieldList(aListKind : TFieldListKind) : UTF8String;
+
+Const
+  SepComma = ', ';
+  SepAND = ' AND ';
+  SepSpace = ' ';
+
+Const
+  Seps : Array[TFieldListKind] of string = (sepComma,sepComma,sepComma,sepComma,sepAnd,sepSpace,sepComma);
+
+Const
+  Wheres = [flWhereKey];
+  Colons = Wheres + [flInsertParams];
+  UseEqual = Wheres+[flUpdate];
+
+Var
+  Term,Res,Prefix : UTF8String;
+  I : Integer;
+  F : TSQLDBRestField;
+
+begin
+  Prefix:='';
+  Res:='';
+  If aListKind in Colons then
+    Prefix:=':';
+  For I:=0 to Fields.Count-1 do
+    begin
+    Term:='';
+    F:=Fields[i];
+    if F.UseInFieldList(aListKind) then
+      begin
+      Term:=Prefix+F.FieldName;
+      if aListKind in UseEqual then
+        begin
+        Term := F.FieldName+' = '+Term;
+        if (aListKind in Wheres) then
+          Term:='('+Term+')';
+        end;
+      end;
+    if (Term<>'') then
+      begin
+      If (Res<>'') then
+        Res:=Res+Seps[aListKind];
+      Res:=Res+Term;
+      end;
+    end;
+  Result:=Res;
+end;
+
+function TSQLDBRestResource.GetFieldArray(aListKind: TFieldListKind
+  ): TSQLDBRestFieldArray;
+Var
+  I,aCount : Integer;
+  F : TSQLDBRestField;
+begin
+  Result:=Default(TSQLDBRestFieldArray);
+  aCount:=0;
+  SetLength(Result,Fields.Count);
+  For I:=0 to Fields.Count-1 do
+    begin
+    F:=Fields[i];
+    if F.UseInFieldList(aListKind) then
+      begin
+      Result[aCount]:=F;
+      Inc(aCount);
+      end;
+    end;
+  SetLength(Result,aCount);
+end;
+
+function TSQLDBRestResource.GenerateDefaultSQL(aKind: TSQLKind) : UTF8String;
+
+begin
+  Case aKind of
+    skSelect :
+      Result:='SELECT '+GetFieldList(flSelect)+' FROM '+TableName+' %FULLWHERE% %FULLORDERBY% %LIMIT%';
+    skInsert :
+      Result:='INSERT INTO '+TableName+' ('+GetFieldList(flInsert)+') VALUES ('+GetFieldList(flInsertParams)+')';
+    skUpdate :
+      Result:='UPDATE '+TableName+' SET '+GetFieldList(flUpdate)+' %FULLWHERE%';
+    skDelete :
+      Result:='DELETE FROM '+TableName+' %FULLWHERE%';
+  else
+    Raise ESQLDBRest.CreateFmt(500,SErrUnknownStatement,[Ord(aKind)]);
+  end;
+end;
+
+function TSQLDBRestResource.GetResolvedSQl(aKind: TSQLKind;
+  const AWhere: UTF8String; const aOrderBy: UTF8String; aLimit: UTF8String
+  ): UTF8String;
+
+Var
+  S : UTF8String;
+
+begin
+  Result:=SQL[aKind].Text;
+  if (Result='') then
+    Result:=GenerateDefaultSQL(aKind);
+  if (aWhere<>'') then
+    S:='WHERE '+aWhere
+  else
+    S:='';
+  Result:=StringReplace(Result,'%FULLWHERE%',S,[rfReplaceAll]);
+  if (aWhere<>'') then
+    S:=aWhere
+  else
+    S:='(1=0)';
+  Result:=StringReplace(Result,'%REQUIREDWHERE%',S,[rfReplaceAll]);
+  if (aWhere<>'') then
+    S:='('+aWhere+')'
+  else
+    S:='';
+  Result:=StringReplace(Result,'%WHERE%',S,[rfReplaceAll]);
+  if (aOrderBy<>'') then
+    S:='ORDER BY '+AOrderBy
+  else
+    S:='';
+  Result:=StringReplace(Result,'%FULLORDERBY%',S,[rfReplaceAll]);
+  Result:=StringReplace(Result,'%ORDERBY%',aOrderBy,[rfReplaceAll]);
+  Result:=StringReplace(Result,'%LIMIT%',aLimit,[rfReplaceAll]);
+end;
+
+class function TSQLDBRestResource.FieldTypeToRestFieldType(
+  aFieldType: TFieldType): TRestFieldType;
+
+Const
+  Map : Array[TFieldType] of TRestFieldType =
+    (rftUnknown, rftString, rftInteger, rftInteger, rftInteger,                // ftUnknown, ftString, ftSmallint, ftInteger, ftWord,
+     rftBoolean, rftFloat, rftFloat, rftFloat, rftDate, rftTime, rftDateTime, // ftBoolean, ftFloat, ftCurrency, ftBCD, ftDate,  ftTime, ftDateTime,
+     rftBlob, rftBlob, rftInteger, rftBlob, rftString, rftUnknown, rftString, // ftBytes, ftVarBytes, ftAutoInc, ftBlob, ftMemo, ftGraphic, ftFmtMemo,
+     rftUnknown, rftUnknown, rftUnknown, rftUnknown, rftString,                // ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor, ftFixedChar,
+     rftString, rftLargeInt, rftUnknown, rftUnknown, rftUnknown,              // ftWideString, ftLargeint, ftADT, ftArray, ftReference,
+     rftUnknown, rftBlob, rftBlob, rftUnknown, rftUnknown,                    //  ftDataSet, ftOraBlob, ftOraClob, ftVariant, ftInterface,
+     rftUnknown, rftString, rftDateTime, rftFloat, rftString, rftString       /// ftIDispatch, ftGuid, ftTimeStamp, ftFMTBcd, ftFixedWideChar, ftWideMemo
+     );
+
+begin
+  Result:=Map[aFieldType];
+end;
+
+procedure TSQLDBRestResource.PopulateFieldsFromFieldDefs(Defs: TFieldDefs; aIndexFields: TStringArray;
+  aProcessIdentifier: TProcessIdentifier; aMinFieldOpts: TRestFieldOptions);
+
+Var
+  I : Integer;
+  F : TSQLDBRestField;
+  FN,PN : UTF8String;
+  O : TRestFieldOptions;
+  RFT : TRestFieldType;
+  FD : TFieldDef;
+
+begin
+  For I:=0 to Defs.Count-1 do
+    begin
+    FD:=Defs[i];
+    RFT:=FieldTypeToRestFieldType(FD.DataType);
+    if RFT=rftUnknown then
+      Continue;
+    FN:=FD.Name;
+    if Assigned(aProcessIdentifier) then
+      PN:=aProcessIdentifier(FN);
+    if SameStr(PN,FN) then // No SameText, Allow to change case
+      PN:='';
+    O:=aMinFieldOpts;
+    if FD.Required then
+       Include(O,foRequired);
+    If AnsiIndexStr(FN,aIndexFields)<>-1 then
+      begin
+      Include(O,foInKey);
+      Exclude(O,foFilter);
+      end;
+    F:=Fields.AddField(FN,RFT,O);
+    if F.FieldType=rftString then
+      F.MaxLen:=FD.Size;
+    F.PublicName:=PN;
+    end;
+end;
+
+class function TSQLDBRestResource.CreateFieldList: TSQLDBRestFieldList;
+
+begin
+  Result:=DefaultFieldListClass.Create(DefaultFieldClass);
+end;
+
+{ TSQLDBRestFieldList }
+
+function TSQLDBRestFieldList.GetFields(aIndex: Integer): TSQLDBRestField;
+begin
+  Result:=TSQLDBRestField(Items[aIndex])
+end;
+
+procedure TSQLDBRestFieldList.SetFields(aIndex : Integer; AValue: TSQLDBRestField);
+begin
+  Items[aIndex]:=aValue;
+end;
+
+function TSQLDBRestFieldList.AddField(const aFieldName: UTF8String; aFieldType: TRestFieldType; aOptions: TRestFieldOptions
+  ): TSQLDBRestField;
+begin
+  if IndexOfFieldName(aFieldName)<>-1 then
+    Raise ESQLDBRest.CreateFmt(500,SDuplicateFieldName,[aFieldName]);
+  Result:=Add as TSQLDBRestField;
+  Result.FieldName:=aFieldName;
+  Result.FieldType:=aFieldType;
+  Result.Options:=aOptions;
+end;
+
+function TSQLDBRestFieldList.indexOfFieldName(const aFieldName : UTF8String): Integer;
+begin
+  Result:=Count-1;
+  While (Result>=0) and not SameText(aFieldName,GetFields(Result).FieldName) do
+    Dec(Result);
+end;
+
+function TSQLDBRestFieldList.FindByFieldName(const aFieldName: UTF8String
+  ): TSQLDBRestField;
+Var
+  I : Integer;
+begin
+  I:=indexOfFieldName(aFieldName);
+  if (I=-1) then
+    Result:=Nil
+  else
+    Result:=GetFields(I);
+end;
+
+function TSQLDBRestFieldList.indexOfPublicName(const aPublicName : UTF8String): Integer;
+begin
+  Result:=Count-1;
+  While (Result>=0) and not SameText(aPublicName,GetFields(Result).PublicName) do
+    Dec(Result);
+end;
+
+function TSQLDBRestFieldList.FindByPublicName(const aFieldName: UTF8String
+  ): TSQLDBRestField;
+Var
+  I : Integer;
+begin
+  I:=indexOfPublicName(aFieldName);
+  if (I=-1) then
+    Result:=Nil
+  else
+    Result:=GetFields(I);
+end;
+
+{ TSQLDBRestField }
+
+function TSQLDBRestField.GetPublicName: UTF8String;
+begin
+  Result:=FPublicName;
+  if (Result='') then
+    Result:=FFieldName;
+end;
+
+constructor TSQLDBRestField.Create(ACollection: TCollection);
+begin
+  inherited Create(ACollection);
+  FFilters:=AllFieldFilters;
+end;
+
+procedure TSQLDBRestField.Assign(Source: TPersistent);
+
+Var
+  F : TSQLDBRestField;
+
+begin
+  if (Source is TSQLDBRestField) then
+    begin
+    F:=source as TSQLDBRestField;
+    FieldName:=F.FieldName;
+    FPublicName:=F.FPublicName;
+    FieldType:=F.FieldType;
+    NativeFieldType:=F.NativeFieldType;
+    Options:=F.Options;
+    Filters:=F.Filters;
+    MaxLen:=F.MaxLen;
+    GeneratorName:=F.GeneratorName;
+    end
+  else
+    inherited Assign(Source);
+end;
+
+function TSQLDBRestField.GetDisplayName: string;
+begin
+  Result:=PublicName;
+end;
+
+function TSQLDBRestField.UseInFieldList(aListKind: TFieldListKind): Boolean;
+begin
+  Result:=True;
+  Case aListKind of
+    flSelect        : Result:=True;
+    flInsert        : Result:=foInInsert in Options;
+    flInsertParams  : Result:=(foInInsert in Options) and not (NativeFieldType=ftAutoInc);
+    flUpdate        : Result:=foInUpdate in Options;
+    flWhereKey      : Result:=foInKey in Options;
+    flFilter        : Result:=foFilter in Options;
+    flOrderby : Result:=([foOrderBy,foOrderByDesc]*options)<>[];
+  end;
+end;
+
+end.
+

packages/fcl-web/src/restbridge/sqldbrestxml.pp

@@ -0,0 +1,315 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2019 by the Free Pascal development team
+
+    SQLDB REST bridge : XML input/output
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit sqldbrestxml;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, DateUtils, db,fpjson, dom, XMLRead, XMLWrite,sqldbrestschema,sqldbrestio, sqldbrestbridge;
+
+Type
+
+  { TXMLInputStreamer }
+
+  TXMLInputStreamer = Class(TRestInputStreamer)
+  private
+    FXML: TXMLDocument;
+    FPacket : TDOMElement;
+    FData : TDOMElement;
+    FRow : TDOMElement;
+  Protected
+    function GetNodeText(N: TDOmNode): UnicodeString;
+  Public
+    Destructor Destroy; override;
+    Class Function GetContentType: String; override;
+    Function SelectObject(aIndex : Integer) : Boolean; override;
+    function GetContentField(aName: UTF8string): TJSONData; override;
+    procedure InitStreaming; override;
+    Property XML : TXMLDocument Read FXML;
+    Property Packet : TDOMElement Read FPacket;
+    Property Data : TDOMElement Read FData;
+    Property Row : TDOMElement Read FRow;
+  end;
+
+  { TXMLOutputStreamer }
+
+  TXMLOutputStreamer = Class(TRestOutputStreamer)
+  Private
+    FXML: TXMLDocument;
+    FData : TDOMElement;
+    FRow: TDOMElement;
+    FRoot: TDomElement;
+  Public
+    procedure EndData; override;
+    procedure EndRow; override;
+    procedure FinalizeOutput; override;
+    procedure StartData; override;
+    procedure StartRow; override;
+    // Return Nil for null field.
+    function FieldToXML(aPair: TRestFieldPair): TDOMElement; virtual;
+    procedure WriteField(aPair: TRestFieldPair); override;
+    procedure WriteMetadata(aFieldList: TRestFieldPairArray); override;
+    Procedure CreateErrorContent(aCode : Integer; Const aMessage: String); override;
+    Property XML : TXMLDocument Read FXML;
+    Property Data : TDOMelement Read FData;
+    Property Row : TDOMelement Read FRow;
+  Public
+    Destructor Destroy; override;
+    Class Function GetContentType: String; override;
+    procedure InitStreaming; override;
+  end;
+
+implementation
+
+uses sqldbrestconst;
+
+{ TXMLInputStreamer }
+
+destructor TXMLInputStreamer.Destroy;
+begin
+  FreeAndNil(FXML);
+  inherited Destroy;
+end;
+
+class function TXMLInputStreamer.GetContentType: String;
+begin
+  Result:='text/xml';
+end;
+
+function TXMLInputStreamer.SelectObject(aIndex: Integer): Boolean;
+
+Var
+  N : TDomNode;
+  NN : UnicodeString;
+begin
+  Result:=False;
+  NN:=UTF8Decode(GetString(rpRowName));
+  N:=FData.FindNode(NN);
+  While (aIndex>0) and (N<>Nil) and (N.NodeName<>NN) and (N.NodeType<>ELEMENT_NODE) do
+    begin
+    N:=N.NextSibling;
+    Dec(aIndex);
+    end;
+  Result:=(aIndex=0) and (N<>Nil);
+  If Result then
+    FRow:=N as TDomElement
+  else
+    FRow:=Nil;
+end;
+
+Function TXMLInputStreamer.GetNodeText(N : TDOmNode) : UnicodeString;
+
+Var
+  V : TDomNode;
+
+begin
+  Result:='';
+  V:=N.FirstChild;
+  While (V<>Nil) and (V.NodeType<>TEXT_NODE) do
+    V:=V.NextSibling;
+  If Assigned(V) then
+    Result:=V.NodeValue;
+end;
+
+function TXMLInputStreamer.GetContentField(aName: UTF8string): TJSONData;
+
+Var
+  NN : UnicodeString;
+  N : TDomNode;
+begin
+  NN:=UTF8Decode(aName);
+  N:=FRow.FindNode(NN);
+  if Assigned(N) and (N.NodeType=ELEMENT_NODE) then
+    Result:=TJSONString.Create(UTF8Encode(GetNodeText(N)));
+end;
+
+procedure TXMLInputStreamer.InitStreaming;
+
+Var
+  Msg : String;
+  N : TDomNode;
+  NN : UnicodeString;
+
+begin
+  FreeAndNil(FXML);
+  if Stream.Size<=0 then
+    exit;
+  try
+    ReadXMLFile(FXML,Stream);
+  except
+    On E : Exception do
+      begin
+      Msg:=E.Message;
+      FXML:=Nil;
+      end;
+  end;
+  if (FXML=Nil)  then
+    Raise ESQLDBRest.CreateFmt(400,SErrInvalidXMLInput,[Msg]);
+  FPacket:=FXML.DocumentElement;
+  NN:=UTF8Decode(GetString(rpXMLDocumentRoot));
+  if (NN<>'') then
+    begin
+    if FPacket.NodeName<>NN then
+      Raise ESQLDBRest.CreateFmt(400,SErrInvalidXMLInput,[SErrMissingDocumentRoot]);
+    NN:=UTF8Decode(GetString(rpDataRoot));
+    N:=FPacket.FindNode(NN);
+    end
+  else
+    begin
+    // if Documentroot is empty, data packet is the root element
+    NN:=UTF8Decode(GetString(rpDataRoot));
+    if (Packet.NodeName=NN) then
+      N:=FPacket
+    else
+      N:=Nil
+    end;
+  if Not (Assigned(N) and (N is TDOMelement)) then
+    Raise ESQLDBRest.CreateFmt(400,SErrInvalidXMLInputMissingElement,[NN]);
+  FData:=(N as TDOMelement);
+end;
+
+{ TXMLOutputStreamer }
+
+
+procedure TXMLOutputStreamer.EndData;
+begin
+  FData:=Nil;
+end;
+
+procedure TXMLOutputStreamer.EndRow;
+begin
+  FRow:=Nil;
+end;
+
+procedure TXMLOutputStreamer.FinalizeOutput;
+
+begin
+  xmlwrite.WriteXML(FXML,Stream);
+  FreeAndNil(FXML);
+end;
+
+procedure TXMLOutputStreamer.StartData;
+begin
+  FData:=FXML.CreateElement(UTF8Decode(GetString(rpDataRoot)));
+  FRoot.AppendChild(FData);
+end;
+
+procedure TXMLOutputStreamer.StartRow;
+begin
+  if (FRow<>Nil) then
+    Raise ESQLDBRest.Create(500,SErrDoubleRowStart);
+  FRow:=FXML.CreateElement(UTF8Decode(GetString(rpRowName)));
+  FData.AppendChild(FRow);
+end;
+
+Function TXMLOutputStreamer.FieldToXML(aPair: TRestFieldPair) : TDomElement;
+
+Var
+  F : TField;
+  S : UTF8String;
+
+begin
+  Result:=Nil;
+  F:=aPair.DBField;;
+  If (aPair.RestField.FieldType=rftUnknown) then
+    raise ESQLDBRest.CreateFmt(500,SErrUnsupportedRestFieldType, [aPair.RestField.PublicName]);
+  If (F.IsNull) then
+    Exit;
+  S:=FieldToString(aPair.RestField.FieldType,F);
+  Result:=FXML.CreateElement(UTF8Decode(aPair.RestField.PublicName));
+  Result.AppendChild(FXML.CreateTextNode(UTF8Decode(S)));
+end;
+
+procedure TXMLOutputStreamer.WriteField(aPair: TRestFieldPair);
+
+Var
+  D : TDOMElement;
+  N : UTF8String;
+
+begin
+  N:=aPair.RestField.PublicName;
+  if FRow=Nil then
+    Raise ESQLDBRest.CreateFmt(500,SErrFieldWithoutRow,[N]);
+  D:=FieldToXML(aPair);
+  if (D=Nil) and (not HasOption(ooSparse)) then
+    D:=FXML.CreateElement(UTF8Decode(aPair.RestField.PublicName));
+  if D<>Nil then
+    FRow.AppendChild(D);
+end;
+
+procedure TXMLOutputStreamer.WriteMetadata(aFieldList: TRestFieldPairArray);
+
+Var
+  M : TDOMElement;
+  F : TDomElement;
+  P : TREstFieldPair;
+begin
+  F:=FXML.CreateElement(UTF8Decode(GetString(rpMetaDataFields)));
+  M:=FXML.CreateElement(UTF8Decode(GetString(rpMetaDataRoot)));
+  M.AppendChild(F);
+  FRoot.AppendChild(M);
+  M:=F;
+  For P in aFieldList do
+    begin
+    F:=FXML.CreateElement(UTF8Decode(GetString(rpMetaDataField)));
+    M.AppendChild(F);
+    F[UTF8Decode(GetString(rpFieldNameProp))]:=UTF8Decode(P.RestField.PublicName);
+    F[UTF8Decode(GetString(rpFieldTypeProp))]:=UTF8Decode(typenames[P.RestField.FieldType]);
+    Case P.RestField.FieldType of
+      rftDate : F[UTF8Decode(GetString(rpFieldDateFormatProp))]:=UTF8Decode(GetString(rpDateFormat));
+      rftTime : F[UTF8Decode(GetString(rpFieldDateFormatProp))]:=UTF8Decode(GetString(rpTimeFormat));
+      rftDateTime : F[UTF8Decode(GetString(rpFieldDateFormatProp))]:=UTF8Decode(GetString(rpDateTimeFormat));
+      rftString : F[UTF8Decode(GetString(rpFieldMaxLenProp))]:=UTF8Decode(IntToStr(P.DBField.Size));
+    end;
+    end;
+end;
+
+class function TXMLOutputStreamer.GetContentType: String;
+begin
+  Result:='text/xml';
+end;
+
+procedure TXMLOutputStreamer.CreateErrorContent(aCode: Integer; const aMessage: String);
+
+Var
+  ErrorObj : TDomElement;
+
+begin
+  ErrorObj:=FXML.CreateElement(UTF8Decode(GetString(rpErrorRoot)));
+  ErrorObj['code']:=UTF8Decode(IntToStr(aCode));
+  ErrorObj['message']:=UTF8Decode(aMessage);
+  FRoot.AppendChild(ErrorObj);
+end;
+
+destructor TXMLOutputStreamer.Destroy;
+begin
+  FreeAndNil(FXML);
+  inherited Destroy;
+end;
+
+procedure TXMLOutputStreamer.InitStreaming;
+begin
+  FXML:=TXMLDocument.Create;
+  FRoot:=FXML.CreateElement('datapacket');
+  FXML.AppendChild(FRoot);
+end;
+
+Initialization
+  TXMLInputStreamer.RegisterStreamer('xml');
+  TXMLOutputStreamer.RegisterStreamer('xml');
+end.
+

packages/lua/src/lua.pas

@@ -126,102 +126,102 @@ type
 (*
 ** state manipulation
 *)
-function lua_newstate(f: lua_Alloc; ud: Pointer): Plua_state; cdecl;
-procedure lua_close(L: Plua_State); cdecl;
-function lua_newthread(L: Plua_State): Plua_State; cdecl;
+function lua_newstate(f: lua_Alloc; ud: Pointer): Plua_state; cdecl; external LUA_NAME;
+procedure lua_close(L: Plua_State); cdecl; external LUA_NAME;
+function lua_newthread(L: Plua_State): Plua_State; cdecl; external LUA_NAME;
 
-function lua_atpanic(L: Plua_State; panicf: lua_CFunction): lua_CFunction; cdecl;
+function lua_atpanic(L: Plua_State; panicf: lua_CFunction): lua_CFunction; cdecl; external LUA_NAME;
 
 (*
 ** basic stack manipulation
 *)
-function lua_gettop(L: Plua_State): Integer; cdecl;
-procedure lua_settop(L: Plua_State; idx: Integer); cdecl;
-procedure lua_pushvalue(L: Plua_State; Idx: Integer); cdecl;
-procedure lua_remove(L: Plua_State; idx: Integer); cdecl;
-procedure lua_insert(L: Plua_State; idx: Integer); cdecl;
-procedure lua_replace(L: Plua_State; idx: Integer); cdecl;
-function lua_checkstack(L: Plua_State; sz: Integer): LongBool; cdecl;
+function lua_gettop(L: Plua_State): Integer; cdecl; external LUA_NAME;
+procedure lua_settop(L: Plua_State; idx: Integer); cdecl; external LUA_NAME;
+procedure lua_pushvalue(L: Plua_State; Idx: Integer); cdecl; external LUA_NAME;
+procedure lua_remove(L: Plua_State; idx: Integer); cdecl; external LUA_NAME;
+procedure lua_insert(L: Plua_State; idx: Integer); cdecl; external LUA_NAME;
+procedure lua_replace(L: Plua_State; idx: Integer); cdecl; external LUA_NAME;
+function lua_checkstack(L: Plua_State; sz: Integer): LongBool; cdecl; external LUA_NAME;
 
-procedure lua_xmove(from, to_: Plua_State; n: Integer); cdecl;
+procedure lua_xmove(from, to_: Plua_State; n: Integer); cdecl; external LUA_NAME;
 
 (*
 ** access functions (stack -> C)
 *)
-function lua_isnumber(L: Plua_State; idx: Integer): LongBool; cdecl;
-function lua_isstring(L: Plua_State; idx: Integer): LongBool; cdecl;
-function lua_iscfunction(L: Plua_State; idx: Integer): LongBool; cdecl;
-function lua_isuserdata(L: Plua_State; idx: Integer): LongBool; cdecl;
-function lua_type(L: Plua_State; idx: Integer): Integer; cdecl;
-function lua_typename(L: Plua_State; tp: Integer): PChar; cdecl;
-
-function lua_equal(L: Plua_State; idx1, idx2: Integer): LongBool; cdecl;
-function lua_rawequal(L: Plua_State; idx1, idx2: Integer): LongBool; cdecl;
-function lua_lessthan(L: Plua_State; idx1, idx2: Integer): LongBool; cdecl;
-
-function lua_tonumber(L: Plua_State; idx: Integer): lua_Number; cdecl;
-function lua_tointeger(L: Plua_State; idx: Integer): lua_Integer; cdecl;
-function lua_toboolean(L: Plua_State; idx: Integer): LongBool; cdecl;
-function lua_tolstring(L: Plua_State; idx: Integer; len: Psize_t): PChar; cdecl;
-function lua_objlen(L: Plua_State; idx: Integer): size_t; cdecl;
-function lua_tocfunction(L: Plua_State; idx: Integer): lua_CFunction; cdecl;
-function lua_touserdata(L: Plua_State; idx: Integer): Pointer; cdecl;
-function lua_tothread(L: Plua_State; idx: Integer): Plua_State; cdecl;
-function lua_topointer(L: Plua_State; idx: Integer): Pointer; cdecl;
+function lua_isnumber(L: Plua_State; idx: Integer): LongBool; cdecl; external LUA_NAME;
+function lua_isstring(L: Plua_State; idx: Integer): LongBool; cdecl; external LUA_NAME;
+function lua_iscfunction(L: Plua_State; idx: Integer): LongBool; cdecl; external LUA_NAME;
+function lua_isuserdata(L: Plua_State; idx: Integer): LongBool; cdecl; external LUA_NAME;
+function lua_type(L: Plua_State; idx: Integer): Integer; cdecl; external LUA_NAME;
+function lua_typename(L: Plua_State; tp: Integer): PChar; cdecl; external LUA_NAME;
+
+function lua_equal(L: Plua_State; idx1, idx2: Integer): LongBool; cdecl; external LUA_NAME;
+function lua_rawequal(L: Plua_State; idx1, idx2: Integer): LongBool; cdecl; external LUA_NAME;
+function lua_lessthan(L: Plua_State; idx1, idx2: Integer): LongBool; cdecl; external LUA_NAME;
+
+function lua_tonumber(L: Plua_State; idx: Integer): lua_Number; cdecl; external LUA_NAME;
+function lua_tointeger(L: Plua_State; idx: Integer): lua_Integer; cdecl; external LUA_NAME;
+function lua_toboolean(L: Plua_State; idx: Integer): LongBool; cdecl; external LUA_NAME;
+function lua_tolstring(L: Plua_State; idx: Integer; len: Psize_t): PChar; cdecl; external LUA_NAME;
+function lua_objlen(L: Plua_State; idx: Integer): size_t; cdecl; external LUA_NAME;
+function lua_tocfunction(L: Plua_State; idx: Integer): lua_CFunction; cdecl; external LUA_NAME;
+function lua_touserdata(L: Plua_State; idx: Integer): Pointer; cdecl; external LUA_NAME;
+function lua_tothread(L: Plua_State; idx: Integer): Plua_State; cdecl; external LUA_NAME;
+function lua_topointer(L: Plua_State; idx: Integer): Pointer; cdecl; external LUA_NAME;
 
 (*
 ** push functions (C -> stack)
 *)
-procedure lua_pushnil(L: Plua_State); cdecl;
-procedure lua_pushnumber(L: Plua_State; n: lua_Number); cdecl;
-procedure lua_pushinteger(L: Plua_State; n: lua_Integer); cdecl;
-procedure lua_pushlstring(L: Plua_State; const s: PChar; l_: size_t); cdecl;
-procedure lua_pushstring(L: Plua_State; const s: PChar); cdecl;
-function lua_pushvfstring(L: Plua_State; const fmt: PChar; argp: Pointer): PChar; cdecl;
-function lua_pushfstring(L: Plua_State; const fmt: PChar): PChar; cdecl; varargs;
-procedure lua_pushcclosure(L: Plua_State; fn: lua_CFunction; n: Integer); cdecl;
-procedure lua_pushboolean(L: Plua_State; b: LongBool); cdecl;
-procedure lua_pushlightuserdata(L: Plua_State; p: Pointer); cdecl;
-procedure lua_pushthread(L: Plua_State); cdecl;
+procedure lua_pushnil(L: Plua_State); cdecl; external LUA_NAME;
+procedure lua_pushnumber(L: Plua_State; n: lua_Number); cdecl; external LUA_NAME;
+procedure lua_pushinteger(L: Plua_State; n: lua_Integer); cdecl; external LUA_NAME;
+procedure lua_pushlstring(L: Plua_State; const s: PChar; l_: size_t); cdecl; external LUA_NAME;
+procedure lua_pushstring(L: Plua_State; const s: PChar); cdecl; external LUA_NAME;
+function lua_pushvfstring(L: Plua_State; const fmt: PChar; argp: Pointer): PChar; cdecl; external LUA_NAME;
+function lua_pushfstring(L: Plua_State; const fmt: PChar): PChar; cdecl; varargs; external LUA_NAME;
+procedure lua_pushcclosure(L: Plua_State; fn: lua_CFunction; n: Integer); cdecl; external LUA_NAME;
+procedure lua_pushboolean(L: Plua_State; b: LongBool); cdecl; external LUA_NAME;
+procedure lua_pushlightuserdata(L: Plua_State; p: Pointer); cdecl; external LUA_NAME;
+procedure lua_pushthread(L: Plua_State); cdecl; external LUA_NAME;
 
 (*
 ** get functions (Lua -> stack)
 *)
-procedure lua_gettable(L: Plua_State; idx: Integer); cdecl;
-procedure lua_getfield(L: Plua_state; idx: Integer; k: PChar); cdecl;
-procedure lua_rawget(L: Plua_State; idx: Integer); cdecl;
-procedure lua_rawgeti(L: Plua_State; idx, n: Integer); cdecl;
-procedure lua_createtable(L: Plua_State; narr, nrec: Integer); cdecl;
-function lua_newuserdata(L: Plua_State; sz: size_t): Pointer; cdecl;
-function lua_getmetatable(L: Plua_State; objindex: Integer): Integer; cdecl;
-procedure lua_getfenv(L: Plua_State; idx: Integer); cdecl;
+procedure lua_gettable(L: Plua_State; idx: Integer); cdecl; external LUA_NAME;
+procedure lua_getfield(L: Plua_state; idx: Integer; k: PChar); cdecl; external LUA_NAME;
+procedure lua_rawget(L: Plua_State; idx: Integer); cdecl; external LUA_NAME;
+procedure lua_rawgeti(L: Plua_State; idx, n: Integer); cdecl; external LUA_NAME;
+procedure lua_createtable(L: Plua_State; narr, nrec: Integer); cdecl; external LUA_NAME;
+function lua_newuserdata(L: Plua_State; sz: size_t): Pointer; cdecl; external LUA_NAME;
+function lua_getmetatable(L: Plua_State; objindex: Integer): Integer; cdecl; external LUA_NAME;
+procedure lua_getfenv(L: Plua_State; idx: Integer); cdecl; external LUA_NAME;
 
 (*
 ** set functions (stack -> Lua)
 *)
-procedure lua_settable(L: Plua_State; idx: Integer); cdecl;
-procedure lua_setfield(L: Plua_State; idx: Integer; k: PChar); cdecl;
-procedure lua_rawset(L: Plua_State; idx: Integer); cdecl;
-procedure lua_rawseti(L: Plua_State; idx, n: Integer); cdecl;
-function lua_setmetatable(L: Plua_State; objindex: Integer): Integer; cdecl;
-function lua_setfenv(L: Plua_State; idx: Integer): Integer; cdecl;
+procedure lua_settable(L: Plua_State; idx: Integer); cdecl; external LUA_NAME;
+procedure lua_setfield(L: Plua_State; idx: Integer; k: PChar); cdecl; external LUA_NAME;
+procedure lua_rawset(L: Plua_State; idx: Integer); cdecl; external LUA_NAME;
+procedure lua_rawseti(L: Plua_State; idx, n: Integer); cdecl; external LUA_NAME;
+function lua_setmetatable(L: Plua_State; objindex: Integer): Integer; cdecl; external LUA_NAME;
+function lua_setfenv(L: Plua_State; idx: Integer): Integer; cdecl; external LUA_NAME;
 
 (*
 ** `load' and `call' functions (load and run Lua code)
 *)
-procedure lua_call(L: Plua_State; nargs, nresults: Integer); cdecl;
-function lua_pcall(L: Plua_State; nargs, nresults, errf: Integer): Integer; cdecl;
-function lua_cpcall(L: Plua_State; func: lua_CFunction; ud: Pointer): Integer; cdecl;
-function lua_load(L: Plua_State; reader: lua_Reader; dt: Pointer; const chunkname: PChar): Integer; cdecl;
+procedure lua_call(L: Plua_State; nargs, nresults: Integer); cdecl; external LUA_NAME;
+function lua_pcall(L: Plua_State; nargs, nresults, errf: Integer): Integer; cdecl; external LUA_NAME;
+function lua_cpcall(L: Plua_State; func: lua_CFunction; ud: Pointer): Integer; cdecl; external LUA_NAME;
+function lua_load(L: Plua_State; reader: lua_Reader; dt: Pointer; const chunkname: PChar): Integer; cdecl; external LUA_NAME;
 
-function lua_dump(L: Plua_State; writer: lua_Writer; data: Pointer): Integer; cdecl;
+function lua_dump(L: Plua_State; writer: lua_Writer; data: Pointer): Integer; cdecl; external LUA_NAME;
 
 (*
 ** coroutine functions
 *)
-function lua_yield(L: Plua_State; nresults: Integer): Integer; cdecl;
-function lua_resume(L: Plua_State; narg: Integer): Integer; cdecl;
-function lua_status(L: Plua_State): Integer; cdecl;
+function lua_yield(L: Plua_State; nresults: Integer): Integer; cdecl; external LUA_NAME;
+function lua_resume(L: Plua_State; narg: Integer): Integer; cdecl; external LUA_NAME;
+function lua_status(L: Plua_State): Integer; cdecl; external LUA_NAME;
 
 (*
 ** Garbage-collection functions and options
@@ -236,19 +236,19 @@ const
   LUA_GCSETPAUSE   = 6;
   LUA_GCSETSTEPMUL = 7;
 
-function lua_gc(L: Plua_State; what, data: Integer): Integer; cdecl;
+function lua_gc(L: Plua_State; what, data: Integer): Integer; cdecl; external LUA_NAME;
 
 (*
 ** miscellaneous functions
 *)
-function lua_error(L: Plua_State): Integer; cdecl;
+function lua_error(L: Plua_State): Integer; cdecl; external LUA_NAME;
 
-function lua_next(L: Plua_State; idx: Integer): Integer; cdecl;
+function lua_next(L: Plua_State; idx: Integer): Integer; cdecl; external LUA_NAME;
 
-procedure lua_concat(L: Plua_State; n: Integer); cdecl;
+procedure lua_concat(L: Plua_State; n: Integer); cdecl; external LUA_NAME;
 
-function lua_getallocf(L: Plua_State; ud: PPointer): lua_Alloc; cdecl;
-procedure lua_setallocf(L: Plua_State; f: lua_Alloc; ud: Pointer); cdecl;
+function lua_getallocf(L: Plua_State; ud: PPointer): lua_Alloc; cdecl; external LUA_NAME;
+procedure lua_setallocf(L: Plua_State; f: lua_Alloc; ud: Pointer); cdecl; external LUA_NAME;
 
 (*
 ** ===============================================================
@@ -353,90 +353,6 @@ begin
   Result := LUA_GLOBALSINDEX - i;
 end;
 
-function lua_newstate(f: lua_Alloc; ud: Pointer): Plua_State; cdecl; external LUA_NAME;
-procedure lua_close(L: Plua_State); cdecl; external LUA_NAME;
-function lua_newthread(L: Plua_State): Plua_State; cdecl; external LUA_NAME;
-
-function lua_atpanic(L: Plua_State; panicf: lua_CFunction): lua_CFunction; cdecl; external LUA_NAME;
-
-function lua_gettop(L: Plua_State): Integer; cdecl; external LUA_NAME;
-procedure lua_settop(L: Plua_State; idx: Integer); cdecl; external LUA_NAME;
-procedure lua_pushvalue(L: Plua_State; Idx: Integer); cdecl; external LUA_NAME;
-procedure lua_remove(L: Plua_State; idx: Integer); cdecl; external LUA_NAME;
-procedure lua_insert(L: Plua_State; idx: Integer); cdecl; external LUA_NAME;
-procedure lua_replace(L: Plua_State; idx: Integer); cdecl; external LUA_NAME;
-function lua_checkstack(L: Plua_State; sz: Integer): LongBool; cdecl; external LUA_NAME;
-procedure lua_xmove(from, to_: Plua_State; n: Integer); cdecl; external LUA_NAME;
-
-function lua_isnumber(L: Plua_State; idx: Integer): LongBool; cdecl; external LUA_NAME;
-function lua_isstring(L: Plua_State; idx: Integer): LongBool; cdecl; external LUA_NAME;
-function lua_iscfunction(L: Plua_State; idx: Integer): LongBool; cdecl; external LUA_NAME;
-function lua_isuserdata(L: Plua_State; idx: Integer): LongBool; cdecl; external LUA_NAME;
-function lua_type(L: Plua_State; idx: Integer): Integer; cdecl; external LUA_NAME;
-function lua_typename(L: Plua_State; tp: Integer): PChar; cdecl; external LUA_NAME;
-
-function lua_equal(L: Plua_State; idx1, idx2: Integer): LongBool; cdecl; external LUA_NAME;
-function lua_rawequal(L: Plua_State; idx1, idx2: Integer): LongBool; cdecl; external LUA_NAME;
-function lua_lessthan(L: Plua_State; idx1, idx2: Integer): LongBool; cdecl; external LUA_NAME;
-
-function lua_tonumber(L: Plua_State; idx: Integer): lua_Number; cdecl; external LUA_NAME;
-function lua_tointeger(L: Plua_State; idx: Integer): lua_Integer; cdecl; external LUA_NAME;
-function lua_toboolean(L: Plua_State; idx: Integer): LongBool; cdecl; external LUA_NAME;
-function lua_tolstring(L: Plua_State; idx: Integer; len: Psize_t): PChar; cdecl; external LUA_NAME;
-function lua_objlen(L: Plua_State; idx: Integer): size_t; cdecl; external LUA_NAME;
-function lua_tocfunction(L: Plua_State; idx: Integer): lua_CFunction; cdecl; external LUA_NAME;
-function lua_touserdata(L: Plua_State; idx: Integer): Pointer; cdecl; external LUA_NAME;
-function lua_tothread(L: Plua_State; idx: Integer): Plua_State; cdecl; external LUA_NAME;
-function lua_topointer(L: Plua_State; idx: Integer): Pointer; cdecl; external LUA_NAME;
-
-procedure lua_pushnil(L: Plua_State); cdecl; external LUA_NAME;
-procedure lua_pushnumber(L: Plua_State; n: lua_Number); cdecl; external LUA_NAME;
-procedure lua_pushinteger(L: Plua_State; n: lua_Integer); cdecl; external LUA_NAME;
-procedure lua_pushlstring(L: Plua_State; const s: PChar; l_: size_t); cdecl; external LUA_NAME;
-procedure lua_pushstring(L: Plua_State; const s: PChar); cdecl; external LUA_NAME;
-function lua_pushvfstring(L: Plua_State; const fmt: PChar; argp: Pointer): PChar; cdecl; external LUA_NAME;
-function lua_pushfstring(L: Plua_State; const fmt: PChar): PChar; cdecl; varargs; external LUA_NAME;
-procedure lua_pushcclosure(L: Plua_State; fn: lua_CFunction; n: Integer); cdecl; external LUA_NAME;
-procedure lua_pushboolean(L: Plua_State; b: LongBool); cdecl; external LUA_NAME;
-procedure lua_pushlightuserdata(L: Plua_State; p: Pointer); cdecl; external LUA_NAME;
-procedure lua_pushthread(L: Plua_State); cdecl; external LUA_NAME;
-
-procedure lua_gettable(L: Plua_State; idx: Integer); cdecl; external LUA_NAME;
-procedure lua_getfield(L: Plua_state; idx: Integer; k: PChar); cdecl; external LUA_NAME;
-procedure lua_rawget(L: Plua_State; idx: Integer); cdecl; external LUA_NAME;
-procedure lua_rawgeti(L: Plua_State; idx, n: Integer); cdecl; external LUA_NAME;
-procedure lua_createtable(L: Plua_State; narr, nrec: Integer); cdecl; external LUA_NAME;
-function lua_newuserdata(L: Plua_State; sz: size_t): Pointer; cdecl; external LUA_NAME;
-function lua_getmetatable(L: Plua_State; objindex: Integer): Integer; cdecl; external LUA_NAME;
-procedure lua_getfenv(L: Plua_State; idx: Integer); cdecl; external LUA_NAME;
-
-procedure lua_settable(L: Plua_State; idx: Integer); cdecl; external LUA_NAME;
-procedure lua_setfield(L: Plua_State; idx: Integer; k: PChar); cdecl; external LUA_NAME;
-procedure lua_rawset(L: Plua_State; idx: Integer); cdecl; external LUA_NAME;
-procedure lua_rawseti(L: Plua_State; idx, n: Integer); cdecl; external LUA_NAME;
-function lua_setmetatable(L: Plua_State; objindex: Integer): Integer; cdecl; external LUA_NAME;
-function lua_setfenv(L: Plua_State; idx: Integer): Integer; cdecl; external LUA_NAME;
-
-procedure lua_call(L: Plua_State; nargs, nresults: Integer); cdecl; external LUA_NAME;
-function lua_pcall(L: Plua_State; nargs, nresults, errf: Integer): Integer; cdecl; external LUA_NAME;
-function lua_cpcall(L: Plua_State; func: lua_CFunction; ud: Pointer): Integer; cdecl; external LUA_NAME;
-function lua_load(L: Plua_State; reader: lua_Reader; dt: Pointer; const chunkname: PChar): Integer; cdecl; external LUA_NAME;
-
-function lua_dump(L: Plua_State; writer: lua_Writer; data: Pointer): Integer; cdecl; external LUA_NAME;
-
-function lua_yield(L: Plua_State; nresults: Integer): Integer; cdecl; external LUA_NAME;
-function lua_resume(L: Plua_State; narg: Integer): Integer; cdecl; external LUA_NAME;
-function lua_status(L: Plua_State): Integer; cdecl; external LUA_NAME;
-
-function lua_gc(L: Plua_State; what, data: Integer): Integer; cdecl; external LUA_NAME;
-
-function lua_error(L: Plua_State): Integer; cdecl; external LUA_NAME;
-function lua_next(L: Plua_State; idx: Integer): Integer; cdecl; external LUA_NAME;
-procedure lua_concat(L: Plua_State; n: Integer); cdecl; external LUA_NAME;
-
-function lua_getallocf(L: Plua_State; ud: PPointer): lua_Alloc; cdecl; external LUA_NAME;
-procedure lua_setallocf(L: Plua_State; f: lua_Alloc; ud: Pointer); cdecl; external LUA_NAME;
-
 procedure lua_pop(L: Plua_State; n: Integer);
 begin
   lua_settop(L, -n - 1);

packages/lua/src/lualib.pas

@@ -39,16 +39,16 @@ const
   LUA_DBLIBNAME = 'debug';
   LUA_LOADLIBNAME = 'package';
 
-function luaopen_base(L: Plua_State): LongBool; cdecl;
-function luaopen_table(L: Plua_State): LongBool; cdecl;
-function luaopen_io(L: Plua_State): LongBool; cdecl;
-function luaopen_string(L: Plua_State): LongBool; cdecl;
-function luaopen_math(L: Plua_State): LongBool; cdecl;
-function luaopen_debug(L: Plua_State): LongBool; cdecl;
-function luaopen_package(L: Plua_State): LongBool; cdecl;
+function luaopen_base(L: Plua_State): LongBool; cdecl; external LUA_LIB_NAME;
+function luaopen_table(L: Plua_State): LongBool; cdecl; external LUA_LIB_NAME;
+function luaopen_io(L: Plua_State): LongBool; cdecl; external LUA_LIB_NAME;
+function luaopen_string(L: Plua_State): LongBool; cdecl; external LUA_LIB_NAME;
+function luaopen_math(L: Plua_State): LongBool; cdecl; external LUA_LIB_NAME;
+function luaopen_debug(L: Plua_State): LongBool; cdecl; external LUA_LIB_NAME;
+function luaopen_package(L: Plua_State): LongBool; cdecl; external LUA_LIB_NAME;
 
 (* open all previous libraries *)
-procedure luaL_openlibs(L: Plua_State); cdecl;
+procedure luaL_openlibs(L: Plua_State); cdecl; external LUA_LIB_NAME;
 
 (* compatibility code *)
 
@@ -61,16 +61,6 @@ function lua_dblibopen(L: Plua_State): LongBool;
 
 implementation
 
-function luaopen_base(L: Plua_State): LongBool; cdecl; external LUA_LIB_NAME;
-function luaopen_table(L: Plua_State): LongBool; cdecl; external LUA_LIB_NAME;
-function luaopen_io(L: Plua_State): LongBool; cdecl; external LUA_LIB_NAME;
-function luaopen_string(L: Plua_State): LongBool; cdecl; external LUA_LIB_NAME;
-function luaopen_math(L: Plua_State): LongBool; cdecl; external LUA_LIB_NAME;
-function luaopen_debug(L: Plua_State): LongBool; cdecl; external LUA_LIB_NAME;
-function luaopen_package(L: Plua_State): LongBool; cdecl; external LUA_LIB_NAME;
-
-procedure luaL_openlibs(L: Plua_State); cdecl; external LUA_LIB_NAME;
-
 function lua_baselibopen(L: Plua_State): LongBool;
 begin
   Result := luaopen_base(L);

packages/pastojs/src/fppas2js.pp

@@ -681,6 +681,7 @@ type
     pbivnRTTIInt_MinValue,
     pbivnRTTIInt_OrdType,
     pbivnRTTILocal, // $r
+    pbivnRTTIMemberAttributes,
     pbivnRTTIMethodKind, // tTypeInfoMethodVar has methodkind
     pbivnRTTIPointer_RefType,
     pbivnRTTIProcFlags,
@@ -689,6 +690,7 @@ type
     pbivnRTTIPropIndex,
     pbivnRTTIPropStored,
     pbivnRTTISet_CompType,
+    pbivnRTTITypeAttributes,
     pbivnSelf,
     pbivnTObjectDestroy,
     pbivnWith,
@@ -714,10 +716,10 @@ type
 
 const
   Pas2JSBuiltInNames: array[TPas2JSBuiltInName] of string = (
-    'arrayConcat', // rtl.arrayConcat
-    'arrayConcatN', // rtl.arrayConcatN
-    'arrayCopy', // rtl.arrayCopy
-    'arrayEq', // rtl.arrayEq
+    'arrayConcat', // rtl.arrayConcat    pbifnArray_Concat
+    'arrayConcatN', // rtl.arrayConcatN   pbifnArray_ConcatN
+    'arrayCopy', // rtl.arrayCopy      pbifnArray_Copy
+    'arrayEq', // rtl.arrayEq          pbifnArray_Equal
     'length', // rtl.length
     'arraySetLength', // rtl.arraySetLength
     '$clone',
@@ -836,37 +838,39 @@ const
     'enumtype',
     'maxvalue',
     'minvalue',
-    'ordtype',
-    '$r',
-    'methodkind',
-    'reftype',
-    'flags',
-    'procsig',
-    'Default',
-    'index',
-    'stored',
-    'comptype',
-    '$Self',
-    'tObjectDestroy', // rtl.tObjectDestroy
-    '$with',
-    '$a',
-    'NativeInt',
-    'tTypeInfo', // rtl.
-    'tTypeInfoClass', // rtl.
-    'tTypeInfoClassRef', // rtl.
-    'tTypeInfoDynArray', // rtl.
-    'tTypeInfoEnum', // rtl.
-    'tTypeInfoHelper', // rtl.
-    'tTypeInfoInteger', // rtl.
-    'tTypeInfoInterface', // rtl.
-    'tTypeInfoMethodVar', // rtl.
-    'tTypeInfoPointer', // rtl.
-    'tTypeInfoProcVar', // rtl.
-    'tTypeInfoRecord', // rtl.
-    'tTypeInfoRefToProcVar', // rtl.
-    'tTypeInfoSet', // rtl.
-    'tTypeInfoStaticArray', // rtl.
-    'NativeUInt'
+    'ordtype', // pbivnRTTIInt_OrdType
+    '$r', // pbivnRTTILocal
+    'attr', // pbivnRTTIMemberAttributes
+    'methodkind', // pbivnRTTIMethodKind
+    'reftype', // pbivnRTTIPointer_RefType
+    'flags', // pbivnRTTIProcFlags
+    'procsig', // pbivnRTTIProcVar_ProcSig
+    'Default', // pbivnRTTIPropDefault
+    'index', // pbivnRTTIPropIndex
+    'stored', // pbivnRTTIPropStored
+    'comptype', // pbivnRTTISet_CompType
+    'attr', // pbivnRTTITypeAttributes
+    '$Self', // pbivnSelf
+    'tObjectDestroy', // rtl.tObjectDestroy  pbivnTObjectDestroy
+    '$with', // pbivnWith
+    '$a', // pbitnAnonymousPostfix
+    'NativeInt', // pbitnIntDouble
+    'tTypeInfo', // pbitnTI
+    'tTypeInfoClass', // pbitnTIClass
+    'tTypeInfoClassRef', // pbitnTIClassRef
+    'tTypeInfoDynArray', // pbitnTIDynArray
+    'tTypeInfoEnum', // pbitnTIEnum
+    'tTypeInfoHelper', // pbitnTIHelper
+    'tTypeInfoInteger', // pbitnTIInteger
+    'tTypeInfoInterface', // pbitnTIInterface
+    'tTypeInfoMethodVar', // pbitnTIMethodVar
+    'tTypeInfoPointer', // pbitnTIPointer
+    'tTypeInfoProcVar', // pbitnTIProcVar
+    'tTypeInfoRecord', // pbitnTIRecord
+    'tTypeInfoRefToProcVar', // pbitnTIRefToProcVar
+    'tTypeInfoSet', // pbitnTISet
+    'tTypeInfoStaticArray', // pbitnTIStaticArray
+    'NativeUInt' // pbitnUIntDouble
     );
 
   // reserved words, not usable as identifiers, not even as sub identifiers
@@ -1161,7 +1165,7 @@ const
     msExternalClass,
     msTypeHelpers,
     msArrayOperators,
-    msIgnoreAttributes,
+    msPrefixedAttributes,
     msOmitRTTI,
     msMultipleScopeHelpers];
 
@@ -1824,10 +1828,16 @@ type
       AContext: TConvertContext); virtual;
     Function CreateRTTINewType(El: TPasType; const CallFuncName: string;
       IsForward: boolean; AContext: TConvertContext; out ObjLit: TJSObjectLiteral): TJSCallExpression; virtual;
-    Function CreateRTTIMemberField(V: TPasVariable; AContext: TConvertContext): TJSElement; virtual;
-    Function CreateRTTIMemberMethod(Proc: TPasProcedure; AContext: TConvertContext): TJSElement; virtual;
-    Function CreateRTTIMemberProperty(Prop: TPasProperty; AContext: TConvertContext): TJSElement; virtual;
+    Function CreateRTTIAttributes(const Attr: TPasExprArray; PosEl: TPasElement; aContext: TConvertContext): TJSElement; virtual;
+    Function CreateRTTIMemberField(Members: TFPList; Index: integer;
+      AContext: TConvertContext): TJSElement; virtual;
+    Function CreateRTTIMemberMethod(Members: TFPList; Index: integer;
+      AContext: TConvertContext): TJSElement; virtual;
+    Function CreateRTTIMemberProperty(Members: TFPList; Index: integer;
+      AContext: TConvertContext): TJSElement; virtual;
     Procedure CreateRTTIAnonymous(El: TPasType; AContext: TConvertContext); virtual;
+    Function CreateRTTIMembers(El: TPasMembersType; Src: TJSSourceElements;
+      FuncContext: TFunctionContext; RTTIExpr: TJSElement; NeedLocalVar: boolean): boolean; virtual;
     // create elements for interfaces
     Procedure AddIntfDelegations(ClassEl: TPasElement; Prop: TPasProperty;
       FinishedGUIDs: TStringList; ObjLit: TJSObjectLiteral; aContext: TFunctionContext);
@@ -12621,6 +12631,8 @@ begin
         AddResourceString(TPasResString(P));
         continue;
         end
+      else if C=TPasAttributes then
+        // ToDo
       else
         RaiseNotSupported(P as TPasElement,AContext,20161024191434);
       Add(E,P);
@@ -12886,6 +12898,9 @@ begin
             continue
           else if C=TPasMethodResolution then
             continue
+          else if C=TPasAttributes then
+            // ToDo
+            continue
           else
             RaiseNotSupported(P,FuncContext,20161221233338);
           if NewEl<>nil then
@@ -14969,65 +14984,24 @@ procedure TPasToJSConverter.CreateRecordRTTI(El: TPasRecordType;
 var
   ObjLit: TJSObjectLiteral;
   Call: TJSCallExpression;
-  ok: Boolean;
-  i: Integer;
-  P: TPasElement;
-  VarSt: TJSVariableStatement;
-  NewEl: TJSElement;
-  C: TClass;
+  HasRTTIMembers: Boolean;
 begin
-  ok:=false;
   Call:=nil;
-  VarSt:=nil;
   try
     // module.$rtti.$Record("typename",{});
     Call:=CreateRTTINewType(El,GetBIName(pbifnRTTINewRecord),false,FuncContext,ObjLit);
     if ObjLit=nil then
       RaiseInconsistency(20190105141430,El);
 
-    // add $r to local vars, to avoid name clashes and for nicer debugging
-    FuncContext.AddLocalVar(GetBIName(pbivnRTTILocal),nil);
-
-    For i:=0 to El.Members.Count-1 do
-      begin
-      P:=TPasElement(El.Members[i]);
-      if P.Visibility in [visPrivate,visStrictPrivate] then
-        continue;
-      if not IsElementUsed(P) then continue;
-      NewEl:=nil;
-      C:=P.ClassType;
-      if C=TPasVariable then
-        NewEl:=CreateRTTIMemberField(TPasVariable(P),FuncContext)
-      else if C.InheritsFrom(TPasProcedure) then
-        NewEl:=CreateRTTIMemberMethod(TPasProcedure(P),FuncContext)
-      else if C=TPasProperty then
-        NewEl:=CreateRTTIMemberProperty(TPasProperty(P),FuncContext)
-      else if C.InheritsFrom(TPasType) then
-        continue
-      else
-        DoError(20190105142236,nSymbolCannotBePublished,sSymbolCannotBePublished,[],P);
-      if NewEl=nil then
-        continue; // e.g. abstract or external proc
-      // add RTTI element
-      if VarSt=nil then
-        begin
-        // add "var $r = module.$rtti.$Record..."
-        VarSt:=CreateVarStatement(GetBIName(pbivnRTTILocal),Call,El);
-        Call:=nil;
-        AddToSourceElements(Src,VarSt);
-        end;
-      AddToSourceElements(Src,NewEl);
-      end;
-    if Call<>nil then
+    HasRTTIMembers:=CreateRTTIMembers(El,Src,FuncContext,Call,false);
+    if not HasRTTIMembers then
       begin
       // no published members, add "module.$rtti.$Record..."
       AddToSourceElements(Src,Call);
-      Call:=nil;
       end;
 
-    ok:=true;
+    Call:=nil;
   finally
-    if not ok then
       Call.Free;
   end;
 end;
@@ -15620,61 +15594,37 @@ end;
 
 procedure TPasToJSConverter.AddClassRTTI(El: TPasClassType;
   Src: TJSSourceElements; FuncContext: TFunctionContext);
-
-  function IsMemberNeeded(aMember: TPasElement): boolean;
-  begin
-    Result:=IsElementUsed(aMember);
-  end;
-
 var
-  HasRTTIMembers: Boolean;
-  i: Integer;
-  P: TPasElement;
-  NewEl: TJSElement;
-  VarSt: TJSVariableStatement;
-  C: TClass;
+  HasRTTIMembers, NeedLocalVar: Boolean;
+  RTTIExpr, AttrJS: TJSElement;
+  Attr: TPasExprArray;
+  AssignSt: TJSAssignStatement;
 begin
-  // add $r to local vars, to avoid name clashes and for nicer debugging
-  FuncContext.AddLocalVar(GetBIName(pbivnRTTILocal),nil);
+  AttrJS:=nil;
+  // this.$rtti
+  RTTIExpr:=CreateMemberExpression(['this',GetBIName(pbivnRTTI)]);
+  try
+    Attr:=FuncContext.Resolver.GetAttributeCallsEl(El);
+    AttrJS:=CreateRTTIAttributes(Attr,El,FuncContext);
+    NeedLocalVar:=AttrJS<>nil;
 
-  HasRTTIMembers:=false;
-  For i:=0 to El.Members.Count-1 do
-    begin
-    P:=TPasElement(El.Members[i]);
-    //writeln('TPasToJSConverter.ConvertClassType RTTI El[',i,']=',GetObjName(P));
-    if El.ObjKind=okInterface then
-      // all interface methods are published
-    else if P.Visibility<>visPublished then
-      continue;
-    if not IsMemberNeeded(P) then continue;
-    NewEl:=nil;
-    C:=P.ClassType;
-    if C=TPasVariable then
-      NewEl:=CreateRTTIMemberField(TPasVariable(P),FuncContext)
-    else if C.InheritsFrom(TPasProcedure) then
-      NewEl:=CreateRTTIMemberMethod(TPasProcedure(P),FuncContext)
-    else if C=TPasProperty then
-      NewEl:=CreateRTTIMemberProperty(TPasProperty(P),FuncContext)
-    else if C.InheritsFrom(TPasType) then
-      continue
-    else if C=TPasMethodResolution then
-      continue
-    else
-      DoError(20170409202315,nSymbolCannotBePublished,sSymbolCannotBePublished,[],P);
-    if NewEl=nil then
-      continue; // e.g. abstract or external proc
-    // add RTTI element
-    if not HasRTTIMembers then
-      begin
-      // add "var $r = this.$rtti"
-      VarSt:=CreateVarStatement(GetBIName(pbivnRTTILocal),
-        CreateMemberExpression(['this',GetBIName(pbivnRTTI)]),El);
-      AddToSourceElements(Src,VarSt);
+    HasRTTIMembers:=CreateRTTIMembers(El,Src,FuncContext,RTTIExpr,NeedLocalVar);
+    if HasRTTIMembers then
+      RTTIExpr:=nil;
 
-      HasRTTIMembers:=true;
+    if AttrJS<>nil then
+      begin
+      // $r.attr = [];
+      AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
+      AddToSourceElements(Src,AssignSt);
+      AssignSt.LHS:=CreateMemberExpression([GetBIName(pbivnRTTILocal),GetBIName(pbivnRTTITypeAttributes)]);
+      AssignSt.Expr:=AttrJS;
+      AttrJS:=nil;
       end;
-    AddToSourceElements(Src,NewEl);
-    end;
+  finally
+    AttrJS.Free;
+    RTTIExpr.Free;
+  end;
 end;
 
 procedure TPasToJSConverter.AddClassConstructors(FuncContext: TFunctionContext;
@@ -16402,9 +16352,15 @@ var
   RttiPath, TypeName: String;
   Call: TJSCallExpression;
   aModule: TPasModule;
+  aResolver: TPas2JSResolver;
+  Attr: TPasExprArray;
+  AttrJS: TJSElement;
+  ObjLitEl: TJSObjectLiteralElement;
 begin
   Result:=nil;
   ObjLit:=nil;
+
+  aResolver:=AContext.Resolver;
   // get module path
   aModule:=El.GetModule;
   if aModule=nil then
@@ -16430,7 +16386,18 @@ begin
       // add {}
       ObjLit:=TJSObjectLiteral(CreateElement(TJSObjectLiteral,El));
       Call.AddArg(ObjLit);
+
+      Attr:=aResolver.GetAttributeCallsEl(El);
+      AttrJS:=CreateRTTIAttributes(Attr,El,AContext);
+      if AttrJS<>nil then
+        begin
+        // attr: [...]
+        ObjLitEl:=ObjLit.Elements.AddElement;
+        ObjLitEl.Name:=TJSString(GetBIName(pbivnRTTITypeAttributes));
+        ObjLitEl.Expr:=AttrJS;
+        end;
       end;
+
     Result:=Call;
   finally
     if Result=nil then
@@ -16438,36 +16405,164 @@ begin
   end;
 end;
 
-function TPasToJSConverter.CreateRTTIMemberField(V: TPasVariable;
-  AContext: TConvertContext): TJSElement;
+function TPasToJSConverter.CreateRTTIAttributes(const Attr: TPasExprArray;
+  PosEl: TPasElement; aContext: TConvertContext): TJSElement;
+// create [Attr1Class,'Attr1ProcName',[Attr1Params],...]
+var
+  AttrArrayLit, ParamsArrayLit: TJSArrayLiteral;
+  i, j: Integer;
+  Expr, ParamExpr: TPasExpr;
+  aResolver: TPas2JSResolver;
+  Ref: TResolvedReference;
+  AttrClass, ConstrParent: TPasClassType;
+  aConstructor: TPasConstructor;
+  aName: String;
+  Params: TPasExprArray;
+  Value: TResEvalValue;
+  JSExpr: TJSElement;
+begin
+  Result:=nil;
+  aResolver:=aContext.Resolver;
+  AttrArrayLit:=nil;
+  try
+    for i:=0 to length(Attr)-1 do
+      begin
+      Expr:=Attr[i];
+      if Expr is TParamsExpr then
+        Expr:=TParamsExpr(Expr).Value;
+      if (Expr is TBinaryExpr) and (TBinaryExpr(Expr).OpCode=eopSubIdent) then
+        Expr:=TBinaryExpr(Expr).right;
+      if not aResolver.IsNameExpr(Expr) then
+        RaiseNotSupported(Expr,aContext,20190222182742,GetObjName(Expr));
+      // attribute class
+      Ref:=Expr.CustomData as TResolvedReference;
+      if Ref=nil then
+        // unknown attribute -> silently skip (delphi 10.3 compatible)
+        continue;
+      AttrClass:=Ref.Declaration as TPasClassType;
+      if AttrClass.IsAbstract then
+        continue; // silently skip abstract class (Delphi 10.3 compatible)
+      // attribute constructor name as string
+      if not (Ref.Context is TResolvedRefCtxAttrProc) then
+        RaiseNotSupported(Expr,aContext,20190223085831,GetObjName(Expr));
+      aConstructor:=TResolvedRefCtxAttrProc(Ref.Context).Proc;
+      if aConstructor.IsAbstract then
+        continue; // silently skip abstract method (Delphi 10.3 compatible)
+      ConstrParent:=aConstructor.Parent as TPasClassType;
+      if ConstrParent.HelperForType<>nil then
+        aResolver.RaiseMsg(20190223220134,nXExpectedButYFound,sXExpectedButYFound,
+          ['class method','helper method'],Expr);
+      aName:=TransformVariableName(aConstructor,aContext);
+
+      if AttrArrayLit=nil then
+        AttrArrayLit:=TJSArrayLiteral(CreateElement(TJSArrayLiteral,PosEl));
+
+      // add class reference  pas.system.TCustomAttribute
+      AttrArrayLit.AddElement(CreateReferencePathExpr(AttrClass,aContext));
+      // add constructor name 'Create$1'
+      AttrArrayLit.AddElement(CreateLiteralString(PosEl,aName));
+      // add attribute params as [] if needed
+      ParamsArrayLit:=nil;
+      Expr:=Attr[i];
+      if Expr is TParamsExpr then
+        begin
+        Params:=TParamsExpr(Expr).Params;
+        for j:=0 to length(Params)-1 do
+          begin
+          ParamExpr:=Params[j];
+          Value:=aResolver.Eval(ParamExpr,[]);
+          if Value<>nil then
+            try
+              JSExpr:=ConvertConstValue(Value,aContext,PosEl);
+            finally
+              ReleaseEvalValue(Value);
+            end
+          else
+            JSExpr:=ConvertExpression(ParamExpr,aContext);
+          if ParamsArrayLit=nil then
+            begin
+            ParamsArrayLit:=TJSArrayLiteral(CreateElement(TJSArrayLiteral,PosEl));
+            AttrArrayLit.AddElement(ParamsArrayLit);
+            end;
+          ParamsArrayLit.AddElement(JSExpr);
+          end;
+        end;
+      end;
+    Result:=AttrArrayLit;
+  finally
+    if Result=nil then
+      AttrArrayLit.Free;
+  end;
+end;
+
+function TPasToJSConverter.CreateRTTIMemberField(Members: TFPList;
+  Index: integer; AContext: TConvertContext): TJSElement;
 // create $r.addField("varname",typeinfo);
+// create $r.addField("varname",typeinfo,options);
 var
+  V: TPasVariable;
   Call: TJSCallExpression;
+  OptionsEl: TJSObjectLiteral;
+
+  procedure AddOption(const aName: String; JS: TJSElement);
+  var
+    ObjLit: TJSObjectLiteralElement;
+  begin
+    if JS=nil then exit;
+    if OptionsEl=nil then
+      begin
+      OptionsEl:=TJSObjectLiteral(CreateElement(TJSObjectLiteral,V));
+      Call.AddArg(OptionsEl);
+      end;
+    ObjLit:=OptionsEl.Elements.AddElement;
+    ObjLit.Name:=TJSString(aName);
+    ObjLit.Expr:=JS;
+  end;
+
 var
   JSTypeInfo: TJSElement;
   aName: String;
+  aResolver: TPas2JSResolver;
+  Attr: TPasExprArray;
 begin
   Result:=nil;
+  aResolver:=AContext.Resolver;
+  V:=TPasVariable(Members[Index]);
   if (V.VarType<>nil) and (V.VarType.Name='') then
     CreateRTTIAnonymous(V.VarType,AContext);
 
   JSTypeInfo:=CreateTypeInfoRef(V.VarType,AContext,V);
+  OptionsEl:=nil;
   // Note: create JSTypeInfo first, it may raise an exception
   Call:=CreateCallExpression(V);
-  // $r.addField
-  Call.Expr:=CreateMemberExpression([GetBIName(pbivnRTTILocal),GetBIName(pbifnRTTIAddField)]);
-  // param "varname"
-  aName:=TransformVariableName(V,AContext);
-  Call.AddArg(CreateLiteralString(V,aName));
-  // param typeinfo
-  Call.AddArg(JSTypeInfo);
-  Result:=Call;
+  try
+    // $r.addField
+    Call.Expr:=CreateMemberExpression([GetBIName(pbivnRTTILocal),GetBIName(pbifnRTTIAddField)]);
+    // param "varname"
+    aName:=TransformVariableName(V,AContext);
+    Call.AddArg(CreateLiteralString(V,aName));
+    // param typeinfo
+    Call.AddArg(JSTypeInfo);
+
+    // param options if needed as {}
+    // option: attributes
+    Attr:=aResolver.GetAttributeCalls(Members,Index);
+    if length(Attr)>0 then
+      AddOption(GetBIName(pbivnRTTIMemberAttributes),
+                CreateRTTIAttributes(Attr,V,AContext));
+
+    Result:=Call;
+    Call:=nil;
+  finally
+    Call.Free;
+  end;
 end;
 
-function TPasToJSConverter.CreateRTTIMemberMethod(Proc: TPasProcedure;
-  AContext: TConvertContext): TJSElement;
+function TPasToJSConverter.CreateRTTIMemberMethod(Members: TFPList;
+  Index: integer; AContext: TConvertContext): TJSElement;
 // create $r.addMethod("funcname",methodkind,params,resulttype,options)
 var
+  Proc: TPasProcedure;
   OptionsEl: TJSObjectLiteral;
   ResultTypeInfo: TJSElement;
   Call: TJSCallExpression;
@@ -16476,6 +16571,7 @@ var
   var
     ObjLit: TJSObjectLiteralElement;
   begin
+    if JS=nil then exit;
     if OptionsEl=nil then
       begin
       OptionsEl:=TJSObjectLiteral(CreateElement(TJSObjectLiteral,Proc));
@@ -16495,8 +16591,12 @@ var
   ResultEl: TPasResultElement;
   ProcScope, OverriddenProcScope: TPasProcedureScope;
   OverriddenClass: TPasClassType;
+  aResolver: TPas2JSResolver;
+  Attr: TPasExprArray;
 begin
   Result:=nil;
+  Proc:=TPasProcedure(Members[Index]);
+  aResolver:=AContext.Resolver;
   if Proc.IsOverride then
     begin
     ProcScope:=Proc.CustomData as TPasProcedureScope;
@@ -16564,6 +16664,10 @@ begin
       inc(Flags,pfExternal);
     if Flags>0 then
       AddOption(GetBIName(pbivnRTTIProcFlags),CreateLiteralNumber(Proc,Flags));
+    Attr:=aResolver.GetAttributeCalls(Members,Index);
+    if length(Attr)>0 then
+      AddOption(GetBIName(pbivnRTTIMemberAttributes),
+                CreateRTTIAttributes(Attr,Proc,AContext));
 
     Result:=Call;
   finally
@@ -16572,10 +16676,11 @@ begin
   end;
 end;
 
-function TPasToJSConverter.CreateRTTIMemberProperty(Prop: TPasProperty;
-  AContext: TConvertContext): TJSElement;
+function TPasToJSConverter.CreateRTTIMemberProperty(Members: TFPList;
+  Index: integer; AContext: TConvertContext): TJSElement;
 // create  $r.addProperty("propname",flags,result,"getter","setter",{options})
 var
+  Prop: TPasProperty;
   Call: TJSCallExpression;
   OptionsEl: TJSObjectLiteral;
 
@@ -16588,6 +16693,7 @@ var
   var
     ObjLit: TJSObjectLiteralElement;
   begin
+    if JS=nil then exit;
     if OptionsEl=nil then
       begin
       OptionsEl:=TJSObjectLiteral(CreateElement(TJSObjectLiteral,Prop));
@@ -16608,8 +16714,10 @@ var
   StoredResolved, VarTypeResolved: TPasResolverResult;
   StoredValue, PasValue, IndexValue: TResEvalValue;
   aResolver: TPas2JSResolver;
+  Attr: TPasExprArray;
 begin
   Result:=nil;
+  Prop:=TPasProperty(Members[Index]);
   aResolver:=AContext.Resolver;
   OptionsEl:=nil;
   try
@@ -16726,6 +16834,12 @@ begin
       end;
       end;
 
+    // add option "attr"
+    Attr:=aResolver.GetAttributeCalls(Members,Index);
+    if length(Attr)>0 then
+      AddOption(GetBIName(pbivnRTTIMemberAttributes),
+        CreateRTTIAttributes(Attr,Prop,AContext));
+
     Result:=Call;
   finally
     if Result=nil then
@@ -16764,6 +16878,89 @@ begin
     end;
 end;
 
+function TPasToJSConverter.CreateRTTIMembers(El: TPasMembersType;
+  Src: TJSSourceElements; FuncContext: TFunctionContext; RTTIExpr: TJSElement;
+  NeedLocalVar: boolean): boolean;
+type
+  TMemberType = (
+    mtClass,
+    mtInterface,
+    mtRecord
+    );
+
+  procedure CreateLocalvar;
+  var
+    VarSt: TJSVariableStatement;
+  begin
+    if Result then exit;
+    // add "var $r = module.$rtti.$Record..."
+    Result:=true;
+    VarSt:=CreateVarStatement(GetBIName(pbivnRTTILocal),RTTIExpr,El);
+    AddToSourceElements(Src,VarSt);
+  end;
+
+var
+  mt: TMemberType;
+  i: integer;
+  P: TPasElement;
+  C: TClass;
+  NewEl: TJSElement;
+  Members: TFPList;
+begin
+  Result:=false;
+  if El.ClassType=TPasRecordType then
+    mt:=mtRecord
+  else if El.ClassType=TPasClassType then
+    case TPasClassType(El).ObjKind of
+    okInterface: mt:=mtInterface;
+    else mt:=mtClass;
+    end
+  else
+    RaiseNotSupported(El,FuncContext,20190223211808,GetObjName(El));
+
+  // add $r to local vars, to avoid name clashes and for nicer debugging
+  FuncContext.AddLocalVar(GetBIName(pbivnRTTILocal),nil);
+
+  if NeedLocalVar then
+    CreateLocalvar;
+
+  Members:=El.Members;
+  For i:=0 to Members.Count-1 do
+    begin
+    P:=TPasElement(Members[i]);
+    C:=P.ClassType;
+    // check visibility
+    case mt of
+    mtClass:
+      if P.Visibility<>visPublished then continue;
+    mtInterface: ; // all members of an interface are published
+    mtRecord:
+      // a published record publishes all non private members
+      if P.Visibility in [visPrivate,visStrictPrivate] then
+        continue;
+    end;
+    if not IsElementUsed(P) then continue;
+
+    NewEl:=nil;
+    if C=TPasVariable then
+      NewEl:=CreateRTTIMemberField(Members,i,FuncContext)
+    else if C.InheritsFrom(TPasProcedure) then
+      NewEl:=CreateRTTIMemberMethod(Members,i,FuncContext)
+    else if C=TPasProperty then
+      NewEl:=CreateRTTIMemberProperty(Members,i,FuncContext)
+    else if C.InheritsFrom(TPasType)
+        or (C=TPasAttributes) then
+    else
+      DoError(20190105142236,nSymbolCannotBePublished,sSymbolCannotBePublished,[],P);
+    if NewEl=nil then
+      continue; // e.g. abstract or external proc
+    // add RTTI element
+    if not Result then
+      CreateLocalvar;
+    AddToSourceElements(Src,NewEl);
+    end;
+end;
+
 procedure TPasToJSConverter.AddIntfDelegations(ClassEl: TPasElement;
   Prop: TPasProperty; FinishedGUIDs: TStringList; ObjLit: TJSObjectLiteral;
   aContext: TFunctionContext);
@@ -17395,7 +17592,6 @@ var
     List: TJSStatementList;
   begin
     RgCheck:=nil;
-    writeln('AAA1 CreateRefObj SetExpr=',GetObjName(SetExpr),' SetterArgName=',SetterArgName,' ',bsRangeChecks in AContext.ScannerBoolSwitches);
     if (SetExpr is TJSSimpleAssignStatement)
         and (SetterArgName<>'')
         and (bsRangeChecks in AContext.ScannerBoolSwitches) then
@@ -22044,8 +22240,9 @@ begin
                 and not aResolver.MethodIsStatic(TPasProcedure(P))) then
             IsFull:=true; // needs $record
           end;
-        continue;
         end
+      else if C=TPasAttributes then
+        // ToDo
       else
         RaiseNotSupported(P,FuncContext,20190105105436);
       if NewEl<>nil then

packages/pastojs/src/pas2jsfiler.pp

@@ -71,7 +71,7 @@ uses
 
 const
   PCUMagic = 'Pas2JSCache';
-  PCUVersion = 4;
+  PCUVersion = 5;
   { Version Changes:
     1: initial version
     2: - TPasProperty.ImplementsFunc:String -> Implements:TPasExprArray
@@ -80,6 +80,7 @@ const
     3: changed records from function to objects (pas2js 1.3)
     4: precompiled JS of initialization section now only contains the statements,
        not the whole $init function (pas2js 1.5)
+    5: removed modeswitch ignoreattributes
   }
 
   BuiltInNodeName = 'BuiltIn';
@@ -170,10 +171,9 @@ const
     'ArrayOperators',
     'ExternalClass',
     'PrefixedAttributes',
-    'IgnoreAttributes',
     'OmitRTTI',
     'MultipleScopeHelpers'
-    );
+    ); // Dont forget to update ModeSwitchToInt !
 
   PCUDefaultBoolSwitches: TBoolSwitches = [
     bsHints,
@@ -780,6 +780,7 @@ type
     procedure WriteProcedureScope(Obj: TJSONObject; Scope: TPas2JSProcedureScope; aContext: TPCUWriterContext); virtual;
     procedure WriteProcedure(Obj: TJSONObject; El: TPasProcedure; aContext: TPCUWriterContext); virtual;
     procedure WriteOperator(Obj: TJSONObject; El: TPasOperator; aContext: TPCUWriterContext); virtual;
+    procedure WriteAttributes(Obj: TJSONObject; El: TPasAttributes; aContext: TPCUWriterContext); virtual;
     procedure WriteExtRefSignature(Ref: TPCUFilerElementRef; aContext: TPCUWriterContext); virtual;
     function WriteExternalReference(El: TPasElement; aContext: TPCUWriterContext): TPCUFilerElementRef; virtual;
     procedure WriteExternalReferences(aContext: TPCUWriterContext); virtual;
@@ -869,6 +870,8 @@ type
     procedure Set_ProcedureScope_ImplProc(RefEl: TPasElement; Data: TObject);
     procedure Set_ProcedureScope_Overridden(RefEl: TPasElement; Data: TObject);
     procedure Set_ResolvedReference_Declaration(RefEl: TPasElement; Data: TObject);
+    procedure Set_ResolvedReference_CtxConstructor(RefEl: TPasElement; Data: TObject);
+    procedure Set_ResolvedReference_CtxAttrProc(RefEl: TPasElement; Data: TObject);
   protected
     procedure RaiseMsg(Id: int64; const Msg: string = ''); overload; override;
     function CheckJSONArray(Data: TJSONData; El: TPasElement; const PropName: string): TJSONArray;
@@ -994,6 +997,7 @@ type
     procedure ReadProcedureBody(Obj: TJSONObject; El: TPasProcedure; aContext: TPCUReaderContext); virtual;
     procedure ReadProcedure(Obj: TJSONObject; El: TPasProcedure; aContext: TPCUReaderContext); virtual;
     procedure ReadOperator(Obj: TJSONObject; El: TPasOperator; aContext: TPCUReaderContext); virtual;
+    procedure ReadAttributes(Obj: TJSONObject; El: TPasAttributes; aContext: TPCUReaderContext); virtual;
     procedure ResolvePending; virtual;
     procedure ReadBuiltInSymbols(Obj: TJSONObject; ErrorEl: TPasElement); virtual;
   public
@@ -1388,7 +1392,9 @@ begin
     msExternalClass: Result:=44;
     msPrefixedAttributes: Result:=45;
     // msIgnoreInterfaces: Result:=46;
-    msIgnoreAttributes: Result:=47;
+    // msIgnoreAttributes: Result:=47;
+    msOmitRTTI: Result:=48;
+    msMultipleScopeHelpers: Result:=49;
   end;
 end;
 
@@ -2790,6 +2796,8 @@ begin
     pekArrayParams: Obj.Add('Type','A[]');
     pekFuncParams: Obj.Add('Type','F()');
     pekSet: Obj.Add('Type','[]');
+    else
+      RaiseMsg(20190222012727,El,ExprKindNames[TParamsExpr(El).Kind]);
     end;
     WriteParamsExpr(Obj,TParamsExpr(El),aContext);
     end
@@ -2966,6 +2974,11 @@ begin
       RaiseMsg(20180210130202,El);
     WriteProcedure(Obj,TPasProcedure(El),aContext);
     end
+  else if C=TPasAttributes then
+    begin
+    Obj.Add('Type','Attributes');
+    WriteAttributes(Obj,TPasAttributes(El),aContext);
+    end
   else
     begin
     {$IFDEF VerbosePCUFiler}
@@ -3019,6 +3032,8 @@ end;
 
 procedure TPCUWriter.WriteResolvedReference(Obj: TJSONObject;
   Ref: TResolvedReference; ErrorEl: TPasElement);
+var
+  Ctx: TResolvedRefContext;
 begin
   WriteResolvedRefFlags(Obj,'RefFlags',Ref.Flags,[]);
   if Ref.Access<>rraRead then
@@ -3026,7 +3041,23 @@ begin
   if Ref.WithExprScope<>nil then
     RaiseMsg(20180215132828,ErrorEl);
   if Ref.Context<>nil then
-    RaiseMsg(20180215132849,ErrorEl,GetObjName(Ref.Context));
+    begin
+    Ctx:=Ref.Context;
+    if Ctx.ClassType=TResolvedRefCtxConstructor then
+      begin
+      if TResolvedRefCtxConstructor(Ctx).Typ=nil then
+        RaiseMsg(20190222011342,ErrorEl);
+      AddReferenceToObj(Obj,'RefConstructorType',TResolvedRefCtxConstructor(Ctx).Typ);
+      end
+    else if Ctx.ClassType=TResolvedRefCtxAttrProc then
+      begin
+      if TResolvedRefCtxAttrProc(Ctx).Proc=nil then
+        RaiseMsg(20190222011427,ErrorEl);
+      AddReferenceToObj(Obj,'RefAttrProc',TResolvedRefCtxAttrProc(Ctx).Proc);
+      end
+    else
+      RaiseMsg(20180215132849,ErrorEl,GetObjName(Ref.Context));
+    end;
   AddReferenceToObj(Obj,'RefDecl',Ref.Declaration);
 end;
 
@@ -3806,6 +3837,13 @@ begin
     Obj.Add('TokenBased',El.TokenBased);
 end;
 
+procedure TPCUWriter.WriteAttributes(Obj: TJSONObject; El: TPasAttributes;
+  aContext: TPCUWriterContext);
+begin
+  WritePasElement(Obj,El,aContext);
+  WritePasExprArray(Obj,El,'Calls',El.Calls,aContext);
+end;
+
 procedure TPCUWriter.WriteExtRefSignature(Ref: TPCUFilerElementRef;
   aContext: TPCUWriterContext);
 
@@ -4485,6 +4523,28 @@ begin
   Ref.Declaration:=RefEl;
 end;
 
+procedure TPCUReader.Set_ResolvedReference_CtxConstructor(RefEl: TPasElement;
+  Data: TObject);
+var
+  Ref: TResolvedReference absolute Data;
+begin
+  if RefEl is TPasType then
+    TResolvedRefCtxConstructor(Ref.Context).Typ:=TPasType(RefEl) // no AddRef
+  else
+    RaiseMsg(20190222010314,Ref.Element,GetObjName(RefEl));
+end;
+
+procedure TPCUReader.Set_ResolvedReference_CtxAttrProc(RefEl: TPasElement;
+  Data: TObject);
+var
+  Ref: TResolvedReference absolute Data;
+begin
+  if RefEl is TPasConstructor then
+    TResolvedRefCtxAttrProc(Ref.Context).Proc:=TPasConstructor(RefEl) // no AddRef
+  else
+    RaiseMsg(20190222010821,Ref.Element,GetObjName(RefEl));
+end;
+
 procedure TPCUReader.RaiseMsg(Id: int64; const Msg: string);
 var
   E: EPas2JsReadError;
@@ -4906,7 +4966,7 @@ begin
         end;
     if not Found then
       begin
-      if (FileVersion<2) and (SameText(s,'ignoreinterfaces')) then
+      if (FileVersion<5) and (SameText(s,'ignoreinterfaces')) then
         // ignore old switch
       else
         RaiseMsg(20180202144054,El,'unknown ModeSwitch "'+s+'"');
@@ -5786,6 +5846,11 @@ begin
     'ClassDestructor': ReadProc(TPasClassDestructor,Name);
     'Operator': ReadOper(TPasConstructor,Name);
     'ClassOperator': ReadOper(TPasClassConstructor,Name);
+    'Attributes':
+      begin
+      Result:=CreateElement(TPasAttributes,Name,Parent);
+      ReadAttributes(Obj,TPasAttributes(Result),aContext);
+      end;
     else
       RaiseMsg(20180210143758,Parent,'unknown type "'+LeftStr(aType,100)+'"');
     end;
@@ -5969,6 +6034,16 @@ begin
     if not Found then
       RaiseMsg(20180215134804,ErrorEl,s);
     end;
+  if Obj.Find('RefConstructorType')<>nil then
+    begin
+    Ref.Context:=TResolvedRefCtxConstructor.Create;
+    ReadElementReference(Obj,Ref,'RefConstructorType',@Set_ResolvedReference_CtxConstructor);
+    end
+  else if Obj.Find('RefAttrProc')<>nil then
+    begin
+    Ref.Context:=TResolvedRefCtxAttrProc.Create;
+    ReadElementReference(Obj,Ref,'RefAttrProc',@Set_ResolvedReference_CtxAttrProc);
+    end;
 end;
 
 procedure TPCUReader.ReadPasExpr(Obj: TJSONObject; Expr: TPasExpr;
@@ -7548,6 +7623,13 @@ begin
     El.TokenBased:=b;
 end;
 
+procedure TPCUReader.ReadAttributes(Obj: TJSONObject; El: TPasAttributes;
+  aContext: TPCUReaderContext);
+begin
+  ReadPasElement(Obj,El,aContext);
+  ReadPasExprArray(Obj,El,'Calls',El.Calls,aContext);
+end;
+
 procedure TPCUReader.ResolvePending;
 var
   i: Integer;

packages/pastojs/tests/tcfiler.pas

@@ -121,6 +121,7 @@ type
     procedure CheckRestoredMethodResolution(const Path: string; Orig, Rest: TPasMethodResolution); virtual;
     procedure CheckRestoredProcedure(const Path: string; Orig, Rest: TPasProcedure); virtual;
     procedure CheckRestoredOperator(const Path: string; Orig, Rest: TPasOperator); virtual;
+    procedure CheckRestoredAttributes(const Path: string; Orig, Rest: TPasAttributes); virtual;
   public
     property Analyzer: TPas2JSAnalyzer read FAnalyzer;
     property RestAnalyzer: TPas2JSAnalyzer read FRestAnalyzer;
@@ -163,7 +164,7 @@ type
     procedure TestPC_Initialization;
     procedure TestPC_BoolSwitches;
     procedure TestPC_ClassInterface;
-    procedure TestPC_IgnoreAttributes;
+    procedure TestPC_Attributes;
 
     procedure TestPC_UseUnit;
     procedure TestPC_UseUnit_Class;
@@ -1181,6 +1182,8 @@ begin
     CheckRestoredModule(Path,TPasModule(Orig),TPasModule(Rest))
   else if C.InheritsFrom(TPasSection) then
     CheckRestoredSection(Path,TPasSection(Orig),TPasSection(Rest))
+  else if C=TPasAttributes then
+    CheckRestoredAttributes(Path,TPasAttributes(Orig),TPasAttributes(Rest))
   else
     Fail(Path+': unknown class '+C.ClassName);
 
@@ -1570,6 +1573,12 @@ begin
   CheckRestoredProcedure(Path,Orig,Rest);
 end;
 
+procedure TCustomTestPrecompile.CheckRestoredAttributes(const Path: string;
+  Orig, Rest: TPasAttributes);
+begin
+  CheckRestoredPasExprArray(Path+'.Calls',Orig.Calls,Rest.Calls);
+end;
+
 { TTestPrecompile }
 
 procedure TTestPrecompile.Test_Base256VLQ;
@@ -2213,22 +2222,35 @@ begin
   WriteReadUnit;
 end;
 
-procedure TTestPrecompile.TestPC_IgnoreAttributes;
+procedure TTestPrecompile.TestPC_Attributes;
 begin
   StartUnit(false);
   Add([
   'interface',
-  '{$modeswitch ignoreattributes}',
+  '{$modeswitch PrefixedAttributes}',
   'type',
-  '  [custom1, custom2(1+3,''foo'')] [mod1.custom3]',
   '  TObject = class',
-  '    [custom5()] FS: string;',
-  '    [customProp] property S: string read FS;',
+  '    constructor Create;',
+  '  end;',
+  '  TCustomAttribute = class',
+  '    constructor Create(Id: word);',
+  '  end;',
+  '  [Missing]',
+  '  TBird = class',
+  '    [TCustom]',
+  '    FField: word;',
+  '  end;',
+  '  TRec = record',
+  '    [TCustom]',
+  '    Size: word;',
   '  end;',
   'var',
-  '  [custom6]',
+  '  [TCustom, TCustom(3)]',
   '  o: TObject;',
   'implementation',
+  '[TCustom]',
+  'constructor TObject.Create; begin end;',
+  'constructor TCustomAttribute.Create(Id: word); begin end;',
   'end.',
   '']);
   WriteReadUnit;

packages/pastojs/tests/tcmodules.pas

@@ -474,7 +474,6 @@ type
     Procedure TestAdvRecord_SubInterfaceFail;
     Procedure TestAdvRecord_Constructor;
     Procedure TestAdvRecord_ClassConstructor;
-    // ToDo: classconstructor pcu
 
     // classes
     Procedure TestClass_TObjectDefaultConstructor;
@@ -800,7 +799,9 @@ type
     Procedure TestResourcestringImplementation;
 
     // Attributes
-    Procedure TestAtributes_Ignore;
+    Procedure TestAttributes_Members;
+    Procedure TestAttributes_Types;
+    Procedure TestAttributes_HelperConstructor_Fail;
 
     // Assertions, checks
     procedure TestAssert;
@@ -28494,38 +28495,197 @@ begin
     '']));
 end;
 
-procedure TTestModule.TestAtributes_Ignore;
+procedure TTestModule.TestAttributes_Members;
 begin
+  Converter.Options:=Converter.Options-[coNoTypeInfo];
   StartProgram(false);
   Add([
-  '{$modeswitch ignoreattributes}',
+  '{$modeswitch PrefixedAttributes}',
   'type',
-  '  [custom1, custom2(1+3,''foo'')] [mod1.custom3]',
   '  TObject = class',
-  '    [custom5()] FS: string;',
-  '    [customProp] property S: string read FS;',
+  '    constructor Create;',
   '  end;',
-  'var',
-  '  [custom6]',
-  '  o: TObject;',
+  '  TCustomAttribute = class',
+  '    constructor Create(Id: word);',
+  '  end;',
+  '  [Missing]',
+  '  TBird = class',
+  '  published',
+  '    [Tcustom]',
+  '    FField: word;',
+  '    [tcustom(14)]',
+  '    property Size: word read FField;',
+  '    [Tcustom(15)]',
+  '    procedure Fly; virtual; abstract;',
+  '  end;',
+  '  TRec = record',
+  '    [Tcustom,tcustom(14)]',
+  '    Size: word;',
+  '  end;',
+  'constructor TObject.Create; begin end;',
+  'constructor TCustomAttribute.Create(Id: word); begin end;',
   'begin',
   '']);
   ConvertProgram;
-  CheckSource('TestAtributes_Ignore',
+  CheckSource('TestAttributes_Members',
     LinesToStr([ // statements
     'rtl.createClass($mod, "TObject", null, function () {',
     '  this.$init = function () {',
-    '    this.FS = "";',
     '  };',
     '  this.$final = function () {',
     '  };',
+    '  this.Create = function () {',
+    '    return this;',
+    '  };',
     '});',
-    'this.o = null;',
+    'rtl.createClass($mod, "TCustomAttribute", $mod.TObject, function () {',
+    '  this.Create$1 = function (Id) {',
+    '    return this;',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
+    '  this.$init = function () {',
+    '    $mod.TObject.$init.call(this);',
+    '    this.FField = 0;',
+    '  };',
+    '  var $r = this.$rtti;',
+    '  $r.addField("FField", rtl.word, {',
+    '    attr: [$mod.TCustomAttribute, "Create"]',
+    '  });',
+    '  $r.addProperty(',
+    '    "Size",',
+    '    0,',
+    '    rtl.word,',
+    '    "FField",',
+    '    "",',
+    '    {',
+    '      attr: [$mod.TCustomAttribute, "Create$1", [14]]',
+    '    }',
+    '  );',
+    '  $r.addMethod("Fly", 0, null, null, {',
+    '    attr: [$mod.TCustomAttribute, "Create$1", [15]]',
+    '  });',
+    '});',
+    'rtl.recNewT($mod, "TRec", function () {',
+    '  this.Size = 0;',
+    '  this.$eq = function (b) {',
+    '    return this.Size === b.Size;',
+    '  };',
+    '  this.$assign = function (s) {',
+    '    this.Size = s.Size;',
+    '    return this;',
+    '  };',
+    '  var $r = $mod.$rtti.$Record("TRec", {});',
+    '  $r.addField("Size", rtl.word, {',
+    '    attr: [',
+    '        $mod.TCustomAttribute,',
+    '        "Create",',
+    '        $mod.TCustomAttribute,',
+    '        "Create$1",',
+    '        [14]',
+    '      ]',
+    '  });',
+    '});',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
+procedure TTestModule.TestAttributes_Types;
+begin
+  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  StartProgram(false);
+  Add([
+  '{$modeswitch PrefixedAttributes}',
+  'type',
+  '  TObject = class',
+  '    constructor Create(Id: word);',
+  '  end;',
+  '  TCustomAttribute = class',
+  '  end;',
+  '  [TCustom(1)]',
+  '  TMyClass = class',
+  '  end;',
+  '  [TCustom(2)]',
+  '  TRec = record',
+  '  end;',
+  '  [TCustom(3)]',
+  '  TInt = type word;',
+  'constructor TObject.Create(Id: word);',
+  'begin',
+  'end;',
+  'var p: pointer;',
+  'begin',
+  '  p:=typeinfo(TMyClass);',
+  '  p:=typeinfo(TRec);',
+  '  p:=typeinfo(TInt);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestAttributes_Types',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.Create = function (Id) {',
+    '    return this;',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TCustomAttribute", $mod.TObject, function () {',
+    '});',
+    'rtl.createClass($mod, "TMyClass", $mod.TObject, function () {',
+    '  var $r = this.$rtti;',
+    '  $r.attr = [$mod.TCustomAttribute, "Create", [1]];',
+    '});',
+    'rtl.recNewT($mod, "TRec", function () {',
+    '  this.$eq = function (b) {',
+    '    return true;',
+    '  };',
+    '  this.$assign = function (s) {',
+    '    return this;',
+    '  };',
+    '  $mod.$rtti.$Record("TRec", {',
+    '    attr: [$mod.TCustomAttribute, "Create", [2]]',
+    '  });',
+    '});',
+    '$mod.$rtti.$inherited("TInt", rtl.word, {',
+    '  attr: [$mod.TCustomAttribute, "Create", [3]]',
+    '});',
+    'this.p = null;',
     '']),
     LinesToStr([ // $mod.$main
+    '$mod.p = $mod.$rtti["TMyClass"];',
+    '$mod.p = $mod.$rtti["TRec"];',
+    '$mod.p = $mod.$rtti["TInt"];',
     '']));
 end;
 
+procedure TTestModule.TestAttributes_HelperConstructor_Fail;
+begin
+  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  StartProgram(false);
+  Add([
+  '{$modeswitch PrefixedAttributes}',
+  'type',
+  '  TObject = class',
+  '    constructor Create;',
+  '  end;',
+  '  TCustomAttribute = class',
+  '  end;',
+  '  THelper = class helper for TCustomAttribute',
+  '    constructor Create(Id: word);',
+  '  end;',
+  '  [TCustom(3)]',
+  '  TMyInt = word;',
+  'constructor TObject.Create; begin end;',
+  'constructor THelper.Create(Id: word); begin end;',
+  'begin',
+  '  if typeinfo(TMyInt)=nil then ;']);
+  //SetExpectedConverterError('aaa',123);
+  ConvertProgram;
+end;
+
 procedure TTestModule.TestAssert;
 begin
   StartProgram(false);

rtl/inc/text.inc

@@ -1858,6 +1858,8 @@ procedure fpc_Read_Text_Char_intern(var f : Text; out c: char); iocheck; [extern
 function fpc_GetBuf_Text(var f : Text) : pchar; iocheck; compilerproc;
 Begin
   Result:=@TextRec(f).Bufptr^[TextRec(f).BufEnd];
+  if TextRec(f).mode=fmOutput then
+    exit;
   If not CheckRead(f) then
     exit;
   If TextRec(f).BufPos>=TextRec(f).BufEnd Then

tests/bench/bansi1.inc

@@ -11,8 +11,8 @@ uses
 {$if defined(UNIX) and defined(THREAD)}
    cthreads,
 {$ifend}
-   sysutils,
-   classes;
+   SysUtils,
+   Classes;
 
 const
   BenchCount = 1;

tests/webtbs/tw35139.pp

@@ -0,0 +1,30 @@
+{ 
+  Check a fix for a bug that appeared in
+  utils/fppkg/lnet/lTelnet.pp 
+}
+
+{$mode objfpc}{$H+}
+
+unit tw35139;
+
+interface
+
+uses
+  Classes, SysUtils;
+
+implementation
+
+var
+  zz: Char;
+  TNames: array[Char] of string;
+initialization
+  for zz := #0 to #255 do
+    TNames[zz] := IntToStr(Ord(zz));
+  TNames[#1] := 'TS_ECHO';
+  TNames[#133] := 'TS_HYI';
+  TNames[#251] := 'TS_WILL';
+  TNames[#252] := 'TS_WONT';
+  TNames[#253] := 'TS_DO';
+  TNames[#254] := 'TS_DONT';
+end.
+

tests/webtbs/tw35139a.pp

@@ -0,0 +1,16 @@
+{ 
+  Check a fix for a bug that appeared in
+  utils/fppkg/lnet/lTelnet.pp 
+}
+
+{$mode objfpc}{$H+}
+
+program tw35139a;
+
+
+uses
+  Classes, SysUtils, tw35139;
+
+begin
+end.
+

utils/pas2js/docs/translation.html

@@ -595,8 +595,8 @@ End.
       <li><i>Double := Currency</i> -> <i>Double = Currency/10000</i></li>
       <li><i>Currency := Double</i> -> <i>Currency = Math.floor(Double*10000)</i></li>
       <li><i>JSValue := Currency</i> -> <i>JSValue = Currency/10000</i></li>
-      <li>Keep in mind that a double has only 52 bits for the number, so calculating
-      values greater than 450,359,962,737 might give a different result than in Delphi/FPC.
+      <li>Keep in mind that a double has only 54 bits for the number, so calculating
+      values greater than 900,719,925,474 might give a different result than in Delphi/FPC.
       See SysUtils.MinCurrency/MaxCurrency</li>
     </ul>
     </div>
@@ -1606,11 +1606,19 @@ function(){
     <li><i>Class.$unitname</i> is the unit name. E.g. <i>TClassA.$unitname == 'MyModule'</i>.</li>
     <li>The "<i>is</i>"-operator is implemented using "<i>isPrototypeOf</i>". Note that "<i>instanceof</i>" cannot be used, because classes are JS objects.</li>
     <li>The "<i>as</i>" operator is implemented as <i>rtl.as(Object,Class)</i>.</li>
-    <li>Supported: constructor, destructor, private, protected, public,
-      strict private, strict protected, class vars, class methods,
-      class constructor, external methods,
-      virtual, override, abstract, call inherited, assigned(), type cast,
-      overloads, reintroduce, sealed class, nested types.</li>
+    <li>Supported:
+      <ul>
+      <li>constructor, destructor</li>
+      <li>private, protected, public, strict private, strict protected</li>
+      <li>class vars, const, nested types</li>
+      <li>methods, class methods, class constructor, external methods</li>
+      <li>method modifiers overload, reintroduce, virtual, override, abstract, static, external name</li>
+      <li>call inherited</li>
+      <li>assigned()</li>
+      <li>type cast</li>
+      <li>class sealed, class abstract</li>
+      </ul>
+      </li>
     <li>Not supported: class destructor</li>
     <li>Property:
       <ul>
@@ -1619,7 +1627,7 @@ function(){
       stored modifier, index modifier.</li>
       <li>Not supported: getter/setter to an array element,
       e.g. <i>property A: char read FArray[0];</i> </li>
-      <li>Class property getter/setter are not static as in Delphi.</li>
+      <li>Class property getter/setter can be static or non static. Delphi: must be static.</li>
       <li>The <i>Index</i> modifier supports any constant, e.g. a string, while
       Delphi only allows an ordinal (longint). -2147483648 is not a special
       number in pas2js. Overriding a property with an index property is allowed
@@ -1918,8 +1926,8 @@ function(){
 
     <div class="section">
     <h2 id="attributes">Translating attributes</h2>
-    Attributes are not yet implemented. To make porting code easier there
-    is a <i>{$modeswitch ignoreattributes}</i>, that ignores attributes.
+    Attributes are stored in the TTypeInfo objects as streams stored in an array.
+    See the <i>TypInfo</i> function <i>GetRTTIAttributes</i> for details.
     </div>
 
     <div class="section">
@@ -3035,8 +3043,8 @@ End.
       <li>SmallInt - signed 16-bit</li>
       <li>LongWord - unsigned 32-bit</li>
       <li>LongInt - signed 32-bit</li>
-      <li>NativeUInt - unsigned 52-bit</li>
-      <li>NativeInt - signed 53-bit</li>
+      <li>NativeUInt - unsigned 53-bit</li>
+      <li>NativeInt - signed 54-bit</li>
     </ul>
     Notes:
     <ul>
@@ -3088,7 +3096,6 @@ End.
     <div class="section">
     <h2 id="notsupportedelements">Not supported elements</h2>
     <ul>
-    <li>Attributes</li>
     <li>Class destructor</li>
     <li>Enums with custom values</li>
     <li>Generics</li>