# revisions: 41022,41023,41024,41025,41026,41046,41058,41062,41063,41064,41066,41067,41075,41078,41082,41083,41084,41086,41087,41123,41124,41125,41132,41144,41145,41147,41148,41149,41151,41152,41154,41155,41156,41157,41162,41188,41189,41190,41192,41218,41221,41223,41224,41225,41234,41235,41238,41239,41244,41246,41251,41252,41255,41256,41257,41259,41270,41272,41273,41275,41276,41278,41279,41292,41293,41294,41295,41297,41298,41300,41301,41302,41303,41304,41312,41313,41319,41326,41327,41328,41329,41333,41338,41339,41340,41344,41346,41348,41350,41358,41359,41360,41361,41362,41364,41365,41378,41386,41387,41388,41389,41390,41392,41426,41427,41430,41431,41433,41434,41435,41436,41437,41438,41439,41440

git-svn-id: branches/fixes_3_2@41996 -

.gitattributes

@@ -3241,6 +3241,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
@@ -3374,6 +3384,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
@@ -6961,6 +6983,7 @@ packages/pastojs/src/pas2jslibcompiler.pp svneol=native#text/plain
 packages/pastojs/src/pas2jslogger.pp svneol=native#text/plain
 packages/pastojs/src/pas2jspcucompiler.pp svneol=native#text/plain
 packages/pastojs/src/pas2jspparser.pp svneol=native#text/plain
+packages/pastojs/src/pas2jsuseanalyzer.pp svneol=native#text/plain
 packages/pastojs/src/pas2jsutils.pp svneol=native#text/plain
 packages/pastojs/tests/tcconverter.pp svneol=native#text/plain
 packages/pastojs/tests/tcfiler.pas svneol=native#text/plain

packages/fcl-js/src/jsbase.pp

@@ -23,11 +23,11 @@ uses
   {$ifdef pas2js}
   js,
   {$endif}
-  Classes, SysUtils;
+  Classes;
 
 const
-  MinSafeIntDouble = -$fffffffffffff-1; // -4503599627370496
-  MaxSafeIntDouble =  $fffffffffffff; //  4503599627370495
+  MinSafeIntDouble = -$1fffffffffffff; // -9007199254740991 53 bits (52 explicitly stored)
+  MaxSafeIntDouble =  $1fffffffffffff; //  9007199254740991
 Type
   TJSType = (jstUNDEFINED,jstNull,jstBoolean,jstNumber,jstString,jstObject,jstReference,jstCompletion);
 

packages/fcl-js/src/jstree.pp

@@ -439,6 +439,13 @@ Type
     Class function PostFixOperatorToken : tjsToken; override;
   end;
 
+  { TJSUnaryBracketsExpression - e.g. '(A)' }
+
+  TJSUnaryBracketsExpression = Class(TJSUnaryExpression)
+  Public
+    Class function PrefixOperatorToken : tjsToken; override;
+    Class function PostFixOperatorToken : tjsToken; override;
+  end;
 
   { TJSBinary - base class }
 
@@ -1432,6 +1439,18 @@ begin
   Result:=tjsThrow;
 end;
 
+{ TJSUnaryBracketsExpression }
+
+class function TJSUnaryBracketsExpression.PrefixOperatorToken: tjsToken;
+begin
+  Result:=tjsBraceOpen;
+end;
+
+class function TJSUnaryBracketsExpression.PostFixOperatorToken: tjsToken;
+begin
+  Result:=tjsBraceClose;
+end;
+
 { TJSUnaryPostMinusMinusExpression }
 
 Class function TJSUnaryPostMinusMinusExpression.PostFixOperatorToken : tjsToken;

packages/fcl-js/src/jswriter.pp

@@ -240,13 +240,16 @@ Type
     Property Options : TWriteOptions Read FOptions Write SetOptions;
     Property IndentSize : Byte Read FIndentSize Write FIndentSize;
     Property UseUTF8 : Boolean Read GetUseUTF8;
-    property LastChar: WideChar read FLastChar;
+    Property LastChar: WideChar read FLastChar;
+    Property SkipCurlyBrackets : Boolean read FSkipCurlyBrackets write FSkipCurlyBrackets;
+    Property SkipRoundBrackets : Boolean read FSkipRoundBrackets write FSkipRoundBrackets;
   end;
   EJSWriter = Class(Exception);
 
 {$ifdef FPC_HAS_CPSTRING}
 Function UTF16ToUTF8(const S: UnicodeString): string;
 {$endif}
+Function QuoteJSString(const S: TJSString; Quote: TJSChar = #0): TJSString;
 
 implementation
 
@@ -273,6 +276,35 @@ begin
 end;
 {$endif}
 
+function QuoteJSString(const S: TJSString; Quote: TJSChar): TJSString;
+var
+  i, j, Count: Integer;
+begin
+  if Quote=#0 then
+    begin
+    if Pos('"',S)>0 then
+      Quote:=''''
+    else
+      Quote:='"';
+    end;
+  Result := '' + Quote;
+  Count := length(S);
+  i := 0;
+  j := 0;
+  while i < Count do
+    begin
+    inc(i);
+    if S[i] = Quote then
+      begin
+      Result := Result + copy(S, 1 + j, i - j) + Quote;
+      j := i;
+      end;
+    end;
+  if i <> j then
+    Result := Result + copy(S, 1 + j, i - j);
+  Result := Result + Quote;
+end;
+
 { TBufferWriter }
 
 function TBufferWriter.GetBufferLength: Integer;
@@ -651,7 +683,7 @@ Var
   p, StartP: Integer;
   MinIndent, CurLineIndent, j, Exp, Code: Integer;
   i: SizeInt;
-  D: TJSNumber;
+  D, AsNumber: TJSNumber;
 begin
   if V.CustomValue<>'' then
     begin
@@ -706,15 +738,17 @@ begin
       exit;
       end;
     jstNumber :
-      if (Frac(V.AsNumber)=0)
-          and (V.AsNumber>=double(MinSafeIntDouble))
-          and (V.AsNumber<=double(MaxSafeIntDouble)) then
+      begin
+      AsNumber:=V.AsNumber;
+      if (Frac(AsNumber)=0)
+          and (AsNumber>=double(MinSafeIntDouble))
+          and (AsNumber<=double(MaxSafeIntDouble)) then
         begin
-        Str(Round(V.AsNumber),S);
+        Str(Round(AsNumber),S);
         end
       else
         begin
-        Str(V.AsNumber,S);
+        Str(AsNumber,S);
         if S[1]=' ' then Delete(S,1,1);
         i:=Pos('E',S);
         if (i>2) then
@@ -728,7 +762,7 @@ begin
             if s[j]='.' then inc(j);
             S2:=LeftStr(S,j)+copy(S,i,length(S));
             val(S2,D,Code);
-            if (Code=0) and (D=V.AsNumber) then
+            if (Code=0) and (D=AsNumber) then
               S:=S2;
             end;
           '9':
@@ -766,9 +800,18 @@ begin
                 end;
             until false;
             val(S2,D,Code);
-            if (Code=0) and (D=V.AsNumber) then
+            if (Code=0) and (D=AsNumber) then
               S:=S2;
             end;
+          else
+            if s[i-1]='0' then
+              begin
+              // 1.2340E...
+              S2:=LeftStr(S,i-2)+copy(S,i,length(S));
+              val(S2,D,Code);
+              if (Code=0) and (D=AsNumber) then
+                S:=S2;
+              end;
           end;
           end;
         // chomp default exponent E+000
@@ -783,6 +826,7 @@ begin
               Delete(S,i,length(S))
             else if (Exp>=-6) and (Exp<=6) then
               begin
+              // small exponent -> use notation without E
               Delete(S,i,length(S));
               j:=Pos('.',S);
               if j>0 then
@@ -826,12 +870,16 @@ begin
               end
             else
               begin
-              // e.g. 1.0E+001  -> 1.0E1
+              // e.g. 1.1E+0010  -> 1.1E10
               S:=LeftStr(S,i)+IntToStr(Exp);
+              if (i >= 4) and (s[i-1] = '0') and (s[i-2] = '.') then
+                // e.g. 1.0E22 -> 1E22
+                Delete(S, i-2, 2);
               end
             end;
           end;
         end;
+      end;
     jstObject : ;
     jstReference : ;
     jstCompletion : ;
@@ -907,10 +955,14 @@ begin
         and (not (A is TJSSourceElements))
         and (not (A is TJSEmptyBlockStatement))
     then
+      begin
+      if FLastChar<>';' then
+        Write(';');
       if C then
-        Write('; ')
+        Write(' ')
       else
-        Writeln(';');
+        Writeln('');
+      end;
     end;
   Writer.CurElement:=LastEl;
   if C then
@@ -1023,14 +1075,11 @@ end;
 
 
 procedure TJSWriter.WriteObjectLiteral(El: TJSObjectLiteral);
-
-
 Var
   i,C : Integer;
   QE,WC : Boolean;
   S : TJSString;
   Prop: TJSObjectLiteralElement;
-
 begin
   C:=El.Elements.Count-1;
   QE:=(woQuoteElementNames in Options);
@@ -1053,7 +1102,14 @@ begin
    Writer.CurElement:=Prop.Expr;
    S:=Prop.Name;
    if QE or not IsValidJSIdentifier(S) then
-     S:='"'+S+'"';
+     begin
+     if (length(S)>1)
+         and (((S[1]='"') and (S[length(S)]='"'))
+           or ((S[1]='''') and (S[length(S)]=''''))) then
+       // already quoted
+     else
+       S:=QuoteJSString(s);
+     end;
    Write(S+': ');
    Indent;
    FSkipRoundBrackets:=true;
@@ -1156,17 +1212,15 @@ begin
     Write(S);
     end;
   WriteJS(El.A);
-  if (S='') then
+  S:=El.PostFixOperator;
+  if (S<>'') then
     begin
-    S:=El.PostFixOperator;
-    if (S<>'') then
-      begin
-      Writer.CurElement:=El;
-      if ((S='-') and (FLastChar='-'))
-          or ((S='+') and (FLastChar='+')) then
-        Write(' ');
-      Write(S);
-      end;
+    Writer.CurElement:=El;
+    case S[1] of
+    '+': if FLastChar='+' then Write(' ');
+    '-': if FLastChar='-' then Write(' ');
+    end;
+    Write(S);
     end;
 end;
 
@@ -1199,10 +1253,12 @@ begin
       begin
       if not (LastEl is TJSStatementList) then
         begin
+        if FLastChar<>';' then
+          Write(';');
         if C then
-          Write('; ')
+          Write(' ')
         else
-          Writeln(';');
+          Writeln('');
         end;
       FSkipCurlyBrackets:=True;
       WriteJS(El.B);
@@ -1211,11 +1267,14 @@ begin
     if (not C) and not (LastEl is TJSStatementList) then
       writeln(';');
     end
-  else if Assigned(El.B) then
+  else if Assigned(El.B) and not IsEmptyStatement(El.B) then
     begin
     WriteJS(El.B);
     if (not C) and not (El.B is TJSStatementList) then
-      writeln(';');
+      if FLastChar=';' then
+        writeln('')
+      else
+        writeln(';');
     end;
   if B then
     begin

packages/fcl-json/src/fpjsonrtti.pp

@@ -777,7 +777,7 @@ begin
     else If AObject is TObjectList then
       Result.Add('Objects',StreamObjectList(TObjectList(AObject)))
     else if (jsoStreamTlist in Options) and (AObject is TList) then
-      Result := TJSONObject(StreamTList(TList(AObject)))
+      Result.Add('Objects', StreamTList(TList(AObject)))
     else
       begin
       PIL:=TPropInfoList.Create(AObject,tkProperties);

packages/fcl-passrc/src/pasresolveeval.pas

@@ -25,7 +25,7 @@ Works:
 - int/uint
   - unary +, -
   - binary: +, -, *, div, mod, ^^, =, <>, <, >, <=, >=, and, or, xor, not, shl, shr
-  - low(), high(), pred(), succ(), ord()
+  - Low(), High(), Pred(), Succ(), Ord(), Lo(), Hi()
   - typecast longint(-1), word(-2), intsingle(-1), uintsingle(1)
 - float:
   - typecast single(double), double(single), float(integer)
@@ -119,7 +119,7 @@ const
   nWrongNumberOfParametersForArray = 3042;
   nCantAssignValuesToAnAddress = 3043;
   nIllegalExpression = 3044;
-  nCantAccessPrivateMember = 3045;
+  nCantAccessXMember = 3045;
   nMustBeInsideALoop = 3046;
   nExpectXArrayElementsButFoundY = 3047;
   nCannotCreateADescendantOfTheSealedXY = 3048;
@@ -161,7 +161,7 @@ const
   nIllegalQualifierInFrontOf = 3085;
   nIllegalQualifierWithin = 3086;
   nMethodClassXInOtherUnitY = 3087;
-  nClassMethodsMustBeStaticInRecords = 3088;
+  nClassMethodsMustBeStaticInX = 3088;
   nCannotMixMethodResolutionAndDelegationAtX = 3089;
   nImplementsDoesNotSupportArrayProperty = 3101;
   nImplementsDoesNotSupportIndex = 3102;
@@ -177,7 +177,16 @@ const
   nIllegalAssignmentToForLoopVar = 3111;
   nFunctionHidesIdentifier_NonProc = 3112;
   nTypeXCannotBeExtendedByATypeHelper = 3113;
-  nDerivedXMustExtendASubClassY = 3114;
+  nTypeXCannotBeExtendedByARecordHelper = 3114;
+  nDerivedXMustExtendASubClassY = 3115;
+  nDefaultPropertyNotAllowedInHelperForX = 3116;
+  nHelpersCannotBeUsedAsTypes = 3117;
+  nBitWiseOperationsAre32Bit = 3118;
+  nImplictConversionUnicodeToAnsi = 3119;
+  nWrongTypeXInArrayConstructor = 3120;
+  nUnknownCustomAttributeX = 3121;
+  nAttributeIgnoredBecauseAbstractX = 3122;
+  nCreatingAnInstanceOfAbstractClassY = 3123;
 
   // using same IDs as FPC
   nVirtualMethodXHasLowerVisibility = 3250; // was 3050
@@ -236,7 +245,7 @@ resourcestring
   sWrongNumberOfParametersForArray = 'Wrong number of parameters for array';
   sCantAssignValuesToAnAddress = 'Can''t assign values to an address';
   sIllegalExpression = 'Illegal expression';
-  sCantAccessPrivateMember = 'Can''t access %s member %s';
+  sCantAccessXMember = 'Can''t access %s member %s';
   sMustBeInsideALoop = '%s must be inside a loop';
   sExpectXArrayElementsButFoundY = 'Expect %s array elements, but found %s';
   sCannotCreateADescendantOfTheSealedXY = 'Cannot create a descendant of the sealed %s "%s"';
@@ -287,7 +296,7 @@ resourcestring
   sIllegalQualifierWithin = 'illegal qualifier "%s" within "%s"';
   sMethodClassXInOtherUnitY = 'method class "%s" in other unit "%s"';
   sNoMatchingImplForIntfMethodXFound = 'No matching implementation for interface method "%s" found';
-  sClassMethodsMustBeStaticInRecords = 'Class methods must be static in records';
+  sClassMethodsMustBeStaticInX = 'Class methods must be static in %s';
   sCannotMixMethodResolutionAndDelegationAtX = 'Cannot mix method resolution and delegation at %s';
   sImplementsDoesNotSupportArrayProperty = '"implements" does dot support array property';
   sImplementsDoesNotSupportIndex = '"implements" does not support "index"';
@@ -302,7 +311,16 @@ resourcestring
   sCantAssignValuesToConstVariable = 'Can''t assign values to const variable';
   sIllegalAssignmentToForLoopVar = 'Illegal assignment to for-loop variable "%s"';
   sTypeXCannotBeExtendedByATypeHelper = 'Type "%s" cannot be extended by a type helper';
+  sTypeXCannotBeExtendedByARecordHelper = 'Type "%s" cannot be extended by a record helper';
   sDerivedXMustExtendASubClassY = 'Derived %s must extend a subclass of "%s" or the class itself';
+  sDefaultPropertyNotAllowedInHelperForX = 'Default property not allowed in helper for %s';
+  sHelpersCannotBeUsedAsTypes = 'helpers cannot be used as types';
+  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 }
@@ -349,9 +367,9 @@ const
   MinSafeIntSingle = -16777216;
   MaxSafeIntSingle =  16777216;
   MaskUIntSingle = $3fffff;
-  MinSafeIntDouble = -$fffffffffffff-1; // -4503599627370496
-  MaxSafeIntDouble =  $fffffffffffff; //  4503599627370495
-  MaskUIntDouble = $fffffffffffff;
+  MinSafeIntDouble = -$1fffffffffffff; // -9007199254740991 54 bits (52 plus signed bit plus implicit highest bit)
+  MaxSafeIntDouble =  $1fffffffffffff; //  9007199254740991
+  MaskUIntDouble = $1fffffffffffff;
 
 type
   { TResEvalValue }
@@ -670,7 +688,6 @@ type
     function EvalSetParamsExpr(Expr: TParamsExpr; Flags: TResEvalFlags): TResEvalSet;
     function EvalSetExpr(Expr: TPasExpr; ExprArray: TPasExprArray; Flags: TResEvalFlags): TResEvalSet;
     function EvalArrayValuesExpr(Expr: TArrayValues; Flags: TResEvalFlags): TResEvalSet;
-    function ExprStringToOrd(Value: TResEvalValue; PosEl: TPasElement): longword; virtual;
     function EvalPrimitiveExprString(Expr: TPrimitiveExpr): TResEvalValue; virtual;
     procedure PredBool(Value: TResEvalBool; ErrorEl: TPasElement);
     procedure SuccBool(Value: TResEvalBool; ErrorEl: TPasElement);
@@ -703,16 +720,20 @@ type
       MinVal, MaxVal: TMaxPrecInt; PosEl: TPasElement; MsgType: TMessageType = mtWarning);
     function ChrValue(Value: TResEvalValue; ErrorEl: TPasElement): TResEvalValue; virtual;
     function OrdValue(Value: TResEvalValue; ErrorEl: TPasElement): TResEvalValue; virtual;
+    function StringToOrd(Value: TResEvalValue; PosEl: TPasElement): longword; virtual;
     procedure PredValue(Value: TResEvalValue; ErrorEl: TPasElement); virtual;
     procedure SuccValue(Value: TResEvalValue; ErrorEl: TPasElement); virtual;
     function EvalStrFunc(Params: TParamsExpr; Flags: TResEvalFlags): TResEvalValue; virtual;
     function EvalStringAddExpr(Expr, LeftExpr, RightExpr: TPasExpr;
       LeftValue, RightValue: TResEvalValue): TResEvalValue; virtual;
+    function LoHiValue(Value: TResEvalValue; ShiftSize: Integer; Mask: LongWord;
+      ErrorEl: TPasElement): TResEvalValue; virtual;
     function EnumTypeCast(EnumType: TPasEnumType; Expr: TPasExpr;
       Flags: TResEvalFlags): TResEvalEnum; virtual;
     {$ifdef FPC_HAS_CPSTRING}
     function CheckValidUTF8(const s: RawByteString; ErrorEl: TPasElement): boolean;
     function GetCodePage(const s: RawByteString): TSystemCodePage;
+    function GetRawByteString(const s: UnicodeString; CodePage: TSystemCodePage; ErrorEl: TPasElement): RawByteString;
     function GetUTF8Str(const s: RawByteString; ErrorEl: TPasElement): String;
     function GetUnicodeStr(const s: RawByteString; ErrorEl: TPasElement): UnicodeString;
     function GetWideChar(const s: RawByteString; out w: WideChar): boolean;
@@ -729,6 +750,7 @@ type
   TResExprEvaluatorClass = class of TResExprEvaluator;
 
 procedure ReleaseEvalValue(var Value: TResEvalValue);
+function NumberIsFloat(const Value: string): boolean;
 
 {$ifdef FPC_HAS_CPSTRING}
 function RawStrToCaption(const r: RawByteString; MaxLength: integer): string;
@@ -751,6 +773,17 @@ begin
   Value:=nil;
 end;
 
+function NumberIsFloat(const Value: string): boolean;
+var
+  i: Integer;
+begin
+  if Value='' then exit(false);
+  if Value[1] in ['$','%','&'] then exit(false);
+  for i:=2 to length(Value) do
+    if Value[i] in ['.','E','e'] then exit(true);
+  Result:=false;
+end;
+
 {$ifdef FPC_HAS_CPSTRING}
 function RawStrToCaption(const r: RawByteString; MaxLength: integer): string;
 var
@@ -1497,10 +1530,10 @@ begin
   {$endif}
   revkUnicodeString:
     begin
-    LeftInt:=ExprStringToOrd(LeftValue,Expr.left);
+    LeftInt:=StringToOrd(LeftValue,Expr.left);
     if RightValue.Kind in revkAllStrings then
       begin
-      RightInt:=ExprStringToOrd(RightValue,Expr.right);
+      RightInt:=StringToOrd(RightValue,Expr.right);
       if LeftInt>RightInt then
         RaiseMsg(20170523151508,nHighRangeLimitLTLowRangeLimit,
           sHighRangeLimitLTLowRangeLimit,[],Expr.Right);
@@ -1861,7 +1894,7 @@ begin
       // float - currency
       try
         {$Q+}
-        aCurrency:=aCurrency - TResEvalCurrency(RightValue).Value;
+        aCurrency:=Flo - TResEvalCurrency(RightValue).Value;
         {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
         Result:=TResEvalCurrency.CreateValue(aCurrency);
       except
@@ -3304,19 +3337,10 @@ begin
       else
         Int:=TResEvalUInt(LeftValue).UInt;
     {$ifdef FPC_HAS_CPSTRING}
-    revkString:
-      if length(TResEvalString(LeftValue).S)<>1 then
-        RaiseMsg(20170714124231,nXExpectedButYFound,sXExpectedButYFound,
-          ['char','string'],Expr)
-      else
-        Int:=ord(TResEvalString(LeftValue).S[1]);
+    revkString,
     {$endif}
     revkUnicodeString:
-      if length(TResEvalUTF16(LeftValue).S)<>1 then
-        RaiseMsg(20170714124320,nXExpectedButYFound,sXExpectedButYFound,
-          ['char','unicodestring'],Expr)
-      else
-        Int:=ord(TResEvalUTF16(LeftValue).S[1]);
+      Int:=StringToOrd(LeftValue,Expr);
     revkEnum:
       Int:=TResEvalEnum(LeftValue).Index;
     else
@@ -3569,13 +3593,13 @@ begin
           Result.ElKind:=revskChar
         else if Result.ElKind<>revskChar then
           RaiseNotYetImplemented(20170713201456,El);
-        if length(TResEvalString(Value).S)<>1 then
+        RangeStart:=StringToOrd(Value,nil);
+        if RangeStart>$ffff then
           begin
           // set of string (not of char)
           ReleaseEvalValue(TResEvalValue(Result));
           exit;
           end;
-        RangeStart:=ord(TResEvalString(Value).S[1]);
         RangeEnd:=RangeStart;
         end;
       {$endif}
@@ -3884,39 +3908,65 @@ begin
   end;
 end;
 
-function TResExprEvaluator.ExprStringToOrd(Value: TResEvalValue;
+function TResExprEvaluator.StringToOrd(Value: TResEvalValue;
   PosEl: TPasElement): longword;
+const
+  Invalid = $12345678; // bigger than $ffff and smaller than $8000000
 var
   {$ifdef FPC_HAS_CPSTRING}
   S: RawByteString;
   {$endif}
   U: UnicodeString;
 begin
+  case Value.Kind of
   {$ifdef FPC_HAS_CPSTRING}
-  if Value.Kind=revkString then
+  revkString:
     begin
     // ord(ansichar)
     S:=TResEvalString(Value).S;
-    if length(S)<>1 then
-      RaiseMsg(20170522221143,nXExpectedButYFound,sXExpectedButYFound,
-        ['char','string'],PosEl)
+    if length(S)=1 then
+      Result:=ord(S[1])
+    else if (length(S)=0) or (length(S)>4) then
+      begin
+      if PosEl<>nil then
+        RaiseMsg(20170522221143,nXExpectedButYFound,sXExpectedButYFound,
+          ['char','string'],PosEl)
+      else
+        exit(Invalid);
+      end
     else
-      Result:=ord(S[1]);
-    end
-  else
+      begin
+      U:=GetUnicodeStr(S,nil);
+      if length(U)<>1 then
+        begin
+        if PosEl<>nil then
+          RaiseMsg(20190124180407,nXExpectedButYFound,sXExpectedButYFound,
+            ['char','string'],PosEl)
+        else
+          exit(Invalid);
+        end;
+      Result:=ord(U[1]);
+      end;
+    end;
   {$endif}
-  if Value.Kind=revkUnicodeString then
+  revkUnicodeString:
     begin
     // ord(widechar)
     U:=TResEvalUTF16(Value).S;
     if length(U)<>1 then
-      RaiseMsg(20170522221358,nXExpectedButYFound,sXExpectedButYFound,
-        ['char','string'],PosEl)
+      begin
+      if PosEl<>nil then
+        RaiseMsg(20170522221358,nXExpectedButYFound,sXExpectedButYFound,
+          ['char','string'],PosEl)
+      else
+        exit(Invalid);
+      end
     else
       Result:=ord(U[1]);
-    end
+    end;
   else
     RaiseNotYetImplemented(20170522220959,PosEl);
+  end;
 end;
 
 function TResExprEvaluator.EvalPrimitiveExprString(Expr: TPrimitiveExpr
@@ -3949,12 +3999,12 @@ function TResExprEvaluator.EvalPrimitiveExprString(Expr: TPrimitiveExpr
     {$endif}
   end;
 
-  procedure AddHash(u: longword);
+  procedure AddHash(u: longword; ForceUTF16: boolean);
   {$ifdef FPC_HAS_CPSTRING}
   var
     h: RawByteString;
   begin
-    if (u>255) and (Result.Kind=revkString) then
+    if ((u>255) or (ForceUTF16)) and (Result.Kind=revkString) then
       begin
       // switch to unicodestring
       h:=TResEvalString(Result).S;
@@ -3970,6 +4020,7 @@ function TResExprEvaluator.EvalPrimitiveExprString(Expr: TPrimitiveExpr
   {$else}
   begin
     TResEvalUTF16(Result).S:=TResEvalUTF16(Result).S+WideChar(u);
+    if ForceUTF16 then ;
   end;
   {$endif}
 
@@ -4056,11 +4107,11 @@ begin
           begin
           // split into two
           dec(u,$10000);
-          AddHash($D800+(u shr 10));
-          AddHash($DC00+(u and $3ff));
+          AddHash($D800+(u shr 10),true);
+          AddHash($DC00+(u and $3ff),true);
           end
         else
-          AddHash(u);
+          AddHash(u,p-StartP>2);
         end
       else
         begin
@@ -4080,7 +4131,7 @@ begin
           end;
         if p=StartP then
           RaiseInternalError(20170523123806);
-        AddHash(u);
+        AddHash(u,false);
         end;
       end;
     '^':
@@ -4091,8 +4142,8 @@ begin
         RaiseInternalError(20181016121520);
       c:=S[p];
       case c of
-      'a'..'z': AddHash(ord(c)-ord('a')+1);
-      'A'..'Z': AddHash(ord(c)-ord('A')+1);
+      'a'..'z': AddHash(ord(c)-ord('a')+1,false);
+      'A'..'Z': AddHash(ord(c)-ord('A')+1,false);
       else RaiseInternalError(20170523123809);
       end;
       inc(p);
@@ -4340,7 +4391,7 @@ begin
         if Value.Kind in revkAllStrings then
           begin
           // string in char..char
-          CharIndex:=ExprStringToOrd(Value,ValueExpr);
+          CharIndex:=StringToOrd(Value,ValueExpr);
           if (CharIndex<RgInt.RangeStart) or (CharIndex>RgInt.RangeEnd) then
             begin
             if EmitHints then
@@ -4551,35 +4602,34 @@ end;
 
 function TResExprEvaluator.OrdValue(Value: TResEvalValue; ErrorEl: TPasElement
   ): TResEvalValue;
+var
+  v: longword;
 begin
+  Result:=nil;
+  v:=0;
   case Value.Kind of
     revkBool:
       if TResEvalBool(Value).B then
-        Result:=TResEvalInt.CreateValue(1)
+        v:=1
       else
-        Result:=TResEvalInt.CreateValue(0);
+        v:=0;
     revkInt,revkUInt:
-      Result:=Value;
+      exit(Value);
     {$ifdef FPC_HAS_CPSTRING}
-    revkString:
-      if length(TResEvalString(Value).S)<>1 then
-        RaiseRangeCheck(20170624160128,ErrorEl)
-      else
-        Result:=TResEvalInt.CreateValue(ord(TResEvalString(Value).S[1]));
+    revkString,
     {$endif}
     revkUnicodeString:
-      if length(TResEvalUTF16(Value).S)<>1 then
-        RaiseRangeCheck(20170624160129,ErrorEl)
-      else
-        Result:=TResEvalInt.CreateValue(ord(TResEvalUTF16(Value).S[1]));
+      v:=StringToOrd(Value,ErrorEl);
     revkEnum:
-      Result:=TResEvalInt.CreateValue(TResEvalEnum(Value).Index);
+      v:=TResEvalEnum(Value).Index;
   else
     {$IFDEF VerbosePasResEval}
     writeln('TResExprEvaluator.OrdValue ',Value.AsDebugString);
     {$ENDIF}
     RaiseNotYetImplemented(20170624155932,ErrorEl);
   end;
+  if v>$ffff then exit;
+  Result:=TResEvalInt.CreateValue(v);
 end;
 
 procedure TResExprEvaluator.PredValue(Value: TResEvalValue; ErrorEl: TPasElement
@@ -4814,10 +4864,43 @@ begin
       RaiseNotYetImplemented(20170601141811,Expr);
     end;
   else
+    {$ifndef FPC_HAS_CPSTRING}
+    if LeftExpr=nil then ; // no Parameter "LeftExpr" not used
+    if RightExpr=nil then ; // no Parameter "RightExpr" not used
+    {$endif}
     RaiseNotYetImplemented(20181219233139,Expr);
   end;
 end;
 
+function TResExprEvaluator.LoHiValue(Value: TResEvalValue; ShiftSize: Integer;
+  Mask: LongWord; ErrorEl: TPasElement): TResEvalValue;
+var
+  uint: LongWord;
+begin
+  case Value.Kind of
+    revkInt:
+      {$IFDEF Pas2js}
+      if ShiftSize=32 then
+        uint := longword(TResEvalInt(Value).Int div $100000000)
+      else
+      {$ENDIF}
+        uint := (TResEvalInt(Value).Int shr ShiftSize) and Mask;
+    revkUInt:
+      {$IFDEF Pas2js}
+      if ShiftSize=32 then
+        uint := longword(TResEvalUInt(Value).UInt div $100000000)
+      else
+      {$ENDIF}
+        uint := (TResEvalUInt(Value).UInt shr ShiftSize) and Mask;
+  else
+    {$IFDEF VerbosePasResEval}
+    writeln('TResExprEvaluator.LoHiValue ',Value.AsDebugString);
+    {$ENDIF}
+    RaiseNotYetImplemented(20190129012100,ErrorEl);
+  end;
+  Result := TResEvalInt.CreateValue(uint);
+end;
+
 function TResExprEvaluator.EnumTypeCast(EnumType: TPasEnumType; Expr: TPasExpr;
   Flags: TResEvalFlags): TResEvalEnum;
 var
@@ -4892,6 +4975,33 @@ begin
     end;
 end;
 
+function TResExprEvaluator.GetRawByteString(const s: UnicodeString;
+  CodePage: TSystemCodePage; ErrorEl: TPasElement): RawByteString;
+var
+  ok: Boolean;
+begin
+  Result:=UTF8Encode(s);
+  if (CodePage=CP_UTF8)
+      or ((DefaultSystemCodePage=CP_UTF8) and ((CodePage=CP_ACP) or (CodePage=CP_NONE))) then
+    begin
+    // to UTF-8
+    SetCodePage(Result,CodePage,false);
+    end
+  else
+    begin
+    // to non UTF-8 -> possible loss
+    ok:=false;
+    try
+      SetCodePage(Result,CodePage,true);
+      ok:=true;
+    except
+    end;
+    if (not ok) or (GetUnicodeStr(Result,ErrorEl)<>s) then
+      LogMsg(20190204165110,mtWarning,nImplictConversionUnicodeToAnsi,
+        sImplictConversionUnicodeToAnsi,[],ErrorEl);
+    end;
+end;
+
 function TResExprEvaluator.GetUTF8Str(const s: RawByteString;
   ErrorEl: TPasElement): String;
 var

packages/fcl-passrc/src/pastree.pp

@@ -57,10 +57,10 @@ resourcestring
   SPasTreeObjectType = 'object';
   SPasTreeClassType = 'class';
   SPasTreeInterfaceType = 'interface';
-  SPasTreeGenericType = 'generic class';
   SPasTreeSpecializedType = 'specialized class type';
-  SPasClassHelperType = 'Class helper type';
-  SPasRecordHelperType = 'Record helper type';
+  SPasClassHelperType = 'class helper type';
+  SPasRecordHelperType = 'record helper type';
+  SPasTypeHelperType = 'type helper type';
   SPasTreeArgument = 'argument';
   SPasTreeProcedureType = 'procedure type';
   SPasTreeResultElement = 'function result';
@@ -197,7 +197,7 @@ type
      pekInherited, pekSelf, pekSpecialize, pekProcedure);
 
   TExprOpCode = (eopNone,
-                 eopAdd,eopSubtract,eopMultiply,eopDivide, eopDiv,eopMod, eopPower,// arithmetic
+                 eopAdd,eopSubtract,eopMultiply,eopDivide{/}, eopDiv{div},eopMod, eopPower,// arithmetic
                  eopShr,eopShl, // bit operations
                  eopNot,eopAnd,eopOr,eopXor, // logical/bit
                  eopEqual, eopNotEqual,  // Logical
@@ -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;
 
@@ -737,10 +738,16 @@ type
 
   TPasObjKind = (
     okObject, okClass, okInterface,
-    okGeneric, // MG: what is okGeneric?
+    // okGeneric  removed in FPC 3.3.1  check instead GenericTemplateTypes.Count>0
     // okSpecialize removed in FPC 3.1.1
     okClassHelper,okRecordHelper,okTypeHelper,
     okDispInterface);
+const
+  okWithFields = [okObject, okClass];
+  okAllHelpers = [okClassHelper,okRecordHelper,okTypeHelper];
+  okWithClassFields = okWithFields+okAllHelpers;
+
+type
 
   TPasClassInterfaceType = (
     citCom, // default
@@ -772,7 +779,6 @@ type
     ExternalNameSpace : String;
     ExternalName : String;
     InterfaceType: TPasClassInterfaceType;
-    Procedure SetGenericTemplates(AList : TFPList); override;
     Function FindMember(MemberClass : TPTreeElement; Const MemberName : String) : TPasElement;
     Function FindMemberInAncestors(MemberClass : TPTreeElement; Const MemberName : String) : TPasElement;
     Function InterfaceGUID : string;
@@ -974,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,
@@ -1074,11 +1092,25 @@ type
   end;
 
   { TPasOperator }
-  TOperatorType = (otUnknown,otImplicit,otExplicit,otMul,otPlus, otMinus, otDivision,otLessThan, otEqual,
-                   otGreaterThan, otAssign,otNotEqual,otLessEqualThan,otGreaterEqualThan,otPower,
-                   otSymmetricalDifference, otInc, otDec, otMod, otNegative, otPositive, otBitWiseOr, otDiv,
-                   otLeftShift, otLogicalOr, otBitwiseAnd, otbitwiseXor,otLogicalAnd,otLogicalNot,otLogicalXor,
-                   otRightShift,otEnumerator, otIn);
+  TOperatorType = (
+    otUnknown,
+    otImplicit, otExplicit,
+    otMul, otPlus, otMinus, otDivision,
+    otLessThan, otEqual, otGreaterThan,
+    otAssign, otNotEqual, otLessEqualThan, otGreaterEqualThan,
+    otPower, otSymmetricalDifference,
+    otInc, otDec,
+    otMod,
+    otNegative, otPositive,
+    otBitWiseOr,
+    otDiv,
+    otLeftShift,
+    otLogicalOr,
+    otBitwiseAnd, otbitwiseXor,
+    otLogicalAnd, otLogicalNot, otLogicalXor,
+    otRightShift,
+    otEnumerator, otIn
+    );
   TOperatorTypes = set of TOperatorType;
 
   TPasOperator = class(TPasFunction)
@@ -1199,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;
 
@@ -1214,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)
@@ -1610,8 +1641,9 @@ const
     'strict private', 'strict protected');
 
   ObjKindNames: array[TPasObjKind] of string = (
-    'object', 'class', 'interface', 'class',
-    'class helper','record helper','type helper','dispinterface');
+    'object', 'class', 'interface',
+    'class helper','record helper','type helper',
+    'dispinterface');
 
   InterfaceTypeNames: array[TPasClassInterfaceType] of string = (
     'COM',
@@ -1750,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;
@@ -2720,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;
@@ -2736,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
@@ -3017,9 +3081,9 @@ begin
     okObject: Result := SPasTreeObjectType;
     okClass: Result := SPasTreeClassType;
     okInterface: Result := SPasTreeInterfaceType;
-    okGeneric : Result := SPasTreeGenericType;
     okClassHelper : Result:=SPasClassHelperType;
     okRecordHelper : Result:=SPasRecordHelperType;
+    okTypeHelper : Result:=SPasTypeHelperType;
   else
     Result:='ObjKind('+IntToStr(ord(ObjKind))+')';
   end;
@@ -3039,12 +3103,6 @@ begin
   ForEachChildCall(aMethodCall,Arg,GUIDExpr,false);
 end;
 
-procedure TPasClassType.SetGenericTemplates(AList: TFPList);
-begin
-  ObjKind:=okGeneric;
-  inherited SetGenericTemplates(AList);
-end;
-
 function TPasClassType.FindMember(MemberClass: TPTreeElement; const MemberName: String): TPasElement;
 
 Var

packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -218,12 +218,16 @@ const
     );
 
 type
+  TPAOtherCheckedEl = (
+    pocClassConstructor
+    );
 
   { TPasAnalyzer }
 
   TPasAnalyzer = class
   private
-    FChecked: array[TPAUseMode] of TPasAnalyzerKeySet; // tree of TElement
+    FModeChecked: array[TPAUseMode] of TPasAnalyzerKeySet; // tree of TElement
+    FOtherChecked: array[TPAOtherCheckedEl] of TPasAnalyzerKeySet; // tree of TElement
     FOnMessage: TPAMessageEvent;
     FOptions: TPasAnalyzerOptions;
     FOverrideLists: TPasAnalyzerKeySet; // tree of TPAOverrideList sorted for Element
@@ -245,12 +249,14 @@ type
     function PAElementExists(El: TPasElement): boolean; inline;
     procedure CreateTree; virtual;
     function MarkElementAsUsed(El: TPasElement; aClass: TPAElementClass = nil): boolean; // true if new
-    function ElementVisited(El: TPasElement; Mode: TPAUseMode): boolean;
+    function ElementVisited(El: TPasElement; Mode: TPAUseMode): boolean; overload;
+    function ElementVisited(El: TPasElement; OtherCheck: TPAOtherCheckedEl): boolean; overload;
     procedure MarkImplScopeRef(El, RefEl: TPasElement; Access: TPSRefAccess);
     procedure UseElement(El: TPasElement; Access: TResolvedRefAccess;
       UseFull: boolean); virtual;
     procedure UseTypeInfo(El: TPasElement); virtual;
-    procedure UseModule(aModule: TPasModule; Mode: TPAUseMode); 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;
     procedure UseImplElement(El: TPasImplElement); virtual;
@@ -260,9 +266,10 @@ type
     procedure UseInheritedExpr(El: TInheritedExpr); virtual;
     procedure UseScopeReferences(Refs: TPasScopeReferences); virtual;
     procedure UseProcedure(Proc: TPasProcedure); virtual;
-    procedure UseProcedureType(ProcType: TPasProcedureType; Mark: boolean); virtual;
+    procedure UseProcedureType(ProcType: TPasProcedureType); virtual;
     procedure UseType(El: TPasType; Mode: TPAUseMode); virtual;
     procedure UseClassOrRecType(El: TPasMembersType; Mode: TPAUseMode); virtual;
+    procedure UseClassConstructor(El: TPasMembersType); virtual;
     procedure UseVariable(El: TPasVariable; Access: TResolvedRefAccess;
       UseFull: boolean); virtual;
     procedure UseResourcestring(El: TPasResString); virtual;
@@ -952,9 +959,19 @@ function TPasAnalyzer.ElementVisited(El: TPasElement; Mode: TPAUseMode
 begin
   if El=nil then
     exit(true);
-  if FChecked[Mode].ContainsItem(El) then exit(true);
+  if FModeChecked[Mode].ContainsItem(El) then exit(true);
+  Result:=false;
+  FModeChecked[Mode].Add(El,false);
+end;
+
+function TPasAnalyzer.ElementVisited(El: TPasElement;
+  OtherCheck: TPAOtherCheckedEl): boolean;
+begin
+  if El=nil then
+    exit(true);
+  if FOtherChecked[OtherCheck].ContainsItem(El) then exit(true);
   Result:=false;
-  FChecked[Mode].Add(El,false);
+  FOtherChecked[OtherCheck].Add(El,false);
 end;
 
 procedure TPasAnalyzer.MarkImplScopeRef(El, RefEl: TPasElement;
@@ -1010,19 +1027,20 @@ begin
   else if C.InheritsFrom(TPasExpr) then
     UseExpr(TPasExpr(El))
   else if C=TPasEnumValue then
-    begin
-    UseExpr(TPasEnumValue(El).Value);
-    repeat
-      MarkElementAsUsed(El);
-      El:=El.Parent;
-    until not (El is TPasType);
-    end
+    UseExpr(TPasEnumValue(El).Value)
   else if C=TPasMethodResolution then
     // nothing to do
   else if (C.InheritsFrom(TPasModule)) or (C=TPasUsesUnit) then
     // e.g. unitname.identifier -> the module is used by the identifier
   else
     RaiseNotSupported(20170307090947,El);
+  repeat
+    El:=El.Parent;
+    if not (El is TPasType) then break;
+    MarkElementAsUsed(El);
+    if El is TPasMembersType then
+      UseClassConstructor(TPasMembersType(El));
+  until false;
 end;
 
 procedure TPasAnalyzer.UseTypeInfo(El: TPasElement);
@@ -1099,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;
@@ -1112,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
@@ -1134,9 +1156,21 @@ begin
     end;
 
   UseElement(El,rraNone,true);
+
+  UseAttributes(El);
 end;
 
-procedure TPasAnalyzer.UseModule(aModule: TPasModule; Mode: TPAUseMode);
+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;
 
   procedure UseInitFinal(ImplBlock: TPasImplBlock);
   var
@@ -1155,7 +1189,8 @@ procedure TPasAnalyzer.UseModule(aModule: TPasModule; Mode: TPAUseMode);
 var
   ModScope: TPasModuleScope;
 begin
-  if ElementVisited(aModule,Mode) then exit;
+  if ElementVisited(aModule,Mode) then exit(false);
+  Result:=true;
 
   {$IFDEF VerbosePasAnalyzer}
   writeln('TPasAnalyzer.UseModule ',GetElModName(aModule),' Mode=',Mode{$IFDEF pas2js},' ',aModule.PasElementId{$ENDIF});
@@ -1180,6 +1215,10 @@ begin
     UseClassOrRecType(ModScope.RangeErrorClass,paumElement);
   if ModScope.RangeErrorConstructor<>nil then
     UseProcedure(ModScope.RangeErrorConstructor);
+  // no need to use here ModScope.AssertClass, it is used by Assert
+  // no need to use here ModScope.AssertMsgConstructor
+  // no need to use here ModScope.AssertDefConstructor
+  // no need to use here ModScope.SystemTVarRec
 
   if Mode=paumElement then
     // e.g. a reference: unitname.identifier
@@ -1259,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;
@@ -1448,11 +1489,17 @@ 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
         begin
-        if Ref.WithExprScope.Scope is TPasRecordScope then
+        if Ref.WithExprScope.ClassRecScope is TPasRecordScope then
           begin
           // a record member was accessed -> access the record too
           UseExprRef(El,Ref.WithExprScope.Expr,Access,false);
@@ -1540,7 +1587,6 @@ begin
   UseExpr(El.format2);
   C:=El.ClassType;
   if (C=TPrimitiveExpr)
-      or (C=TSelfExpr)
       or (C=TBoolConstExpr)
       or (C=TNilExpr) then
     // ok
@@ -1614,7 +1660,7 @@ begin
       RaiseNotSupported(20170403173817,Params);
     end;
     end
-  else if (C=TSelfExpr) or ((C=TPrimitiveExpr) and (TPrimitiveExpr(Expr).Kind=pekIdent)) then
+  else if (C=TPrimitiveExpr) and (TPrimitiveExpr(Expr).Kind=pekIdent) then
     begin
     if (Expr.CustomData is TResolvedReference) then
       begin
@@ -1729,7 +1775,7 @@ begin
   {$ENDIF}
   UseScopeReferences(ProcScope.References);
 
-  UseProcedureType(Proc.ProcType,false);
+  UseProcedureType(Proc.ProcType);
 
   ImplProc:=Proc;
   if ProcScope.ImplProc<>nil then
@@ -1778,8 +1824,7 @@ begin
     end;
 end;
 
-procedure TPasAnalyzer.UseProcedureType(ProcType: TPasProcedureType;
-  Mark: boolean);
+procedure TPasAnalyzer.UseProcedureType(ProcType: TPasProcedureType);
 var
   i: Integer;
   Arg: TPasArgument;
@@ -1787,7 +1832,7 @@ begin
   {$IFDEF VerbosePasAnalyzer}
   writeln('TPasAnalyzer.UseProcedureType ',GetElModName(ProcType));
   {$ENDIF}
-  if Mark and not MarkElementAsUsed(ProcType) then exit;
+  if not MarkElementAsUsed(ProcType) then exit;
 
   for i:=0 to ProcType.Args.Count-1 do
     begin
@@ -1869,7 +1914,7 @@ begin
       UseElType(El,TPasSetType(El).EnumType,Mode);
       end
     else if C.InheritsFrom(TPasProcedureType) then
-      UseProcedureType(TPasProcedureType(El),true)
+      UseProcedureType(TPasProcedureType(El))
     else
       RaiseNotSupported(20170306170315,El);
 
@@ -1939,7 +1984,7 @@ var
   List, ProcList: TFPList;
   o: TObject;
   Map: TPasClassIntfMap;
-  ImplProc, IntfProc: TPasProcedure;
+  ImplProc, IntfProc, Proc: TPasProcedure;
   aClass: TPasClassType;
 begin
   FirstTime:=true;
@@ -1967,7 +2012,7 @@ begin
   ClassScope:=nil;
   IsCOMInterfaceRoot:=false;
 
-  if El is TPasClassType then
+  if El.ClassType=TPasClassType then
     begin
     aClass:=TPasClassType(El);
     if aClass.IsForward then
@@ -2019,43 +2064,53 @@ begin
     Member:=TPasElement(El.Members[i]);
     if FirstTime and (Member is TPasProcedure) then
       begin
+      Proc:=TPasProcedure(Member);
       ProcScope:=Member.CustomData as TPasProcedureScope;
-      if TPasProcedure(Member).IsOverride and (ProcScope.OverriddenProc<>nil) then
+      if Proc.IsOverride and (ProcScope.OverriddenProc<>nil) then
         begin
         // this is an override
         AddOverride(ProcScope.OverriddenProc,Member);
         if ScopeModule<>nil then
           begin
           // when analyzing a single module, all overrides are assumed to be called
-          UseProcedure(TPasProcedure(Member));
+          UseProcedure(Proc);
           continue;
           end;
+        end
+      else if (Proc.ClassType=TPasClassConstructor)
+          or (Proc.ClassType=TPasClassDestructor) then
+        begin
+        UseProcedure(Proc);
+        continue;
         end;
       if IsCOMInterfaceRoot then
         begin
         case lowercase(Member.Name) of
         'queryinterface':
-          if (TPasProcedure(Member).ProcType.Args.Count=2) then
+          if (Proc.ProcType.Args.Count=2) then
             begin
-            UseProcedure(TPasProcedure(Member));
+            UseProcedure(Proc);
             continue;
             end;
         '_addref':
-          if TPasProcedure(Member).ProcType.Args.Count=0 then
+          if Proc.ProcType.Args.Count=0 then
             begin
-            UseProcedure(TPasProcedure(Member));
+            UseProcedure(Proc);
             continue;
             end;
         '_release':
-          if TPasProcedure(Member).ProcType.Args.Count=0 then
+          if Proc.ProcType.Args.Count=0 then
             begin
-            UseProcedure(TPasProcedure(Member));
+            UseProcedure(Proc);
             continue;
             end;
         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
@@ -2116,6 +2171,20 @@ begin
     end;
 end;
 
+procedure TPasAnalyzer.UseClassConstructor(El: TPasMembersType);
+var
+  i: Integer;
+  Member: TPasElement;
+begin
+  if ElementVisited(El,pocClassConstructor) then exit;
+  for i:=0 to El.Members.Count-1 do
+    begin
+    Member:=TPasElement(El.Members[i]);
+    if (Member.ClassType=TPasClassConstructor) or (Member.ClassType=TPasClassDestructor) then
+      UseProcedure(TPasProcedure(Member));
+    end;
+end;
+
 procedure TPasAnalyzer.UseVariable(El: TPasVariable;
   Access: TResolvedRefAccess; UseFull: boolean);
 var
@@ -2401,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);
@@ -2420,6 +2491,7 @@ var
   Usage: TPAElement;
   i: Integer;
   Member: TPasElement;
+  Members: TFPList;
 begin
   {$IFDEF VerbosePasAnalyzer}
   writeln('TPasAnalyzer.EmitTypeHints ',GetElModName(El));
@@ -2442,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);
@@ -2609,10 +2682,20 @@ end;
 constructor TPasAnalyzer.Create;
 var
   m: TPAUseMode;
+  oc: TPAOtherCheckedEl;
 begin
   CreateTree;
   for m in TPAUseMode do
-    FChecked[m]:=TPasAnalyzerKeySet.Create(
+    FModeChecked[m]:=TPasAnalyzerKeySet.Create(
+      {$ifdef pas2js}
+      @PasElementToHashName
+      {$else}
+      @ComparePointer
+      {$endif}
+      ,nil
+      );
+  for oc in TPAOtherCheckedEl do
+    FOtherChecked[oc]:=TPasAnalyzerKeySet.Create(
       {$ifdef pas2js}
       @PasElementToHashName
       {$else}
@@ -2631,23 +2714,29 @@ end;
 destructor TPasAnalyzer.Destroy;
 var
   m: TPAUseMode;
+  oc: TPAOtherCheckedEl;
 begin
   Clear;
   FreeAndNil(FOverrideLists);
   FreeAndNil(FUsedElements);
   for m in TPAUseMode do
-    FreeAndNil(FChecked[m]);
+    FreeAndNil(FModeChecked[m]);
+  for oc in TPAOtherCheckedEl do
+    FreeAndNil(FOtherChecked[oc]);
   inherited Destroy;
 end;
 
 procedure TPasAnalyzer.Clear;
 var
   m: TPAUseMode;
+  oc: TPAOtherCheckedEl;
 begin
   FOverrideLists.FreeItems;
   FUsedElements.FreeItems;
   for m in TPAUseMode do
-    FChecked[m].Clear;
+    FModeChecked[m].Clear;
+  for oc in TPAOtherCheckedEl do
+    FOtherChecked[oc].Clear;
 end;
 
 procedure TPasAnalyzer.AnalyzeModule(aModule: TPasModule);
@@ -2729,7 +2818,7 @@ end;
 
 function TPasAnalyzer.IsTypeInfoUsed(El: TPasElement): boolean;
 begin
-  Result:=FChecked[paumTypeInfo].ContainsItem(El);
+  Result:=FModeChecked[paumTypeInfo].ContainsItem(El);
 end;
 
 function TPasAnalyzer.IsModuleInternal(El: TPasElement): boolean;

packages/fcl-passrc/src/pscanner.pp

@@ -293,9 +293,9 @@ 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 }
-  );
+    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 }
+    );
   TModeSwitches = Set of TModeSwitch;
 
   // switches, that can be 'on' or 'off'
@@ -333,7 +333,8 @@ type
     bsMacro,
     bsScopedEnums,
     bsObjectChecks,   // check methods 'Self' and object type casts
-    bsPointerMath     // pointer arithmetic
+    bsPointerMath,    // pointer arithmetic
+    bsGoto       // support label and goto, set by {$goto on|off}
     );
   TBoolSwitches = set of TBoolSwitch;
 const
@@ -369,8 +370,8 @@ const
   bsAll = [low(TBoolSwitch)..high(TBoolSwitch)];
   bsFPCMode: TBoolSwitches = [bsPointerMath,bsWriteableConst];
   bsObjFPCMode: TBoolSwitches = [bsPointerMath,bsWriteableConst];
-  bsDelphiMode: TBoolSwitches = [bsWriteableConst];
-  bsDelphiUnicodeMode: TBoolSwitches = [bsWriteableConst];
+  bsDelphiMode: TBoolSwitches = [bsWriteableConst,bsGoto];
+  bsDelphiUnicodeMode: TBoolSwitches = [bsWriteableConst,bsGoto];
   bsMacPasMode: TBoolSwitches = [bsPointerMath,bsWriteableConst];
 
 type
@@ -987,7 +988,7 @@ const
     'Tab'
   );
 
-  SModeSwitchNames : array[TModeSwitch] of string{$ifdef fpc}[18]{$endif} =
+  SModeSwitchNames : array[TModeSwitch] of string{$ifdef fpc}[20]{$endif} =
   ( '', // msNone
     '', // Fpc,
     '', // Objfpc,
@@ -1036,8 +1037,8 @@ const
     'ARRAYOPERATORS',
     'EXTERNALCLASS',
     'PREFIXEDATTRIBUTES',
-    'IGNOREATTRIBUTES',
-    'OMITRTTI'
+    'OMITRTTI',
+    'MULTIPLESCOPEHELPERS'
     );
 
   LetterSwitchNames: array['A'..'Z'] of string=(
@@ -1100,7 +1101,8 @@ const
     'Macro',
     'ScopedEnums',
     'ObjectChecks',
-    'PointerMath'
+    'PointerMath',
+    'Goto'
     );
 
   ValueSwitchNames: array[TValueSwitch] of string = (
@@ -1117,7 +1119,7 @@ const
 
 const
   // all mode switches supported by FPC
-  msAllFPCModeSwitches = [low(TModeSwitch)..High(TModeSwitch)];
+  msAllModeSwitches = [low(TModeSwitch)..High(TModeSwitch)];
 
   DelphiModeSwitches = [msDelphi,msClass,msObjpas,msResult,msStringPchar,
      msPointer2Procedure,msAutoDeref,msTPProcVar,msInitFinal,msDefaultAnsistring,
@@ -1128,7 +1130,7 @@ const
 
   DelphiUnicodeModeSwitches = delphimodeswitches + [msSystemCodePage,msDefaultUnicodestring];
 
-  // mode switches of $mode FPC, don't confuse with msAllFPCModeSwitches
+  // mode switches of $mode FPC, don't confuse with msAllModeSwitches
   FPCModeSwitches = [msFpc,msStringPchar,msNestedComment,msRepeatForward,
     msCVarSupport,msInitFinal,msHintDirective,msProperty,msDefaultInline];
   //FPCBoolSwitches bsObjectChecks
@@ -2663,7 +2665,7 @@ begin
   FMaxIncludeStackDepth:=DefaultMaxIncludeStackDepth;
 
   FCurrentModeSwitches:=FPCModeSwitches;
-  FAllowedModeSwitches:=msAllFPCModeSwitches;
+  FAllowedModeSwitches:=msAllModeSwitches;
   FCurrentBoolSwitches:=bsFPCMode;
   FAllowedBoolSwitches:=bsAll;
   FAllowedValueSwitches:=vsAllValueSwitches;
@@ -3396,9 +3398,15 @@ begin
   'OBJFPC':
     SetMode(msObjfpc,OBJFPCModeSwitches,true,bsObjFPCMode);
   'DELPHI':
+    begin
     SetMode(msDelphi,DelphiModeSwitches,true,bsDelphiMode,[bsPointerMath]);
+    SetNonToken(tkgeneric);
+    end;
   'DELPHIUNICODE':
+    begin
     SetMode(msDelphiUnicode,DelphiUnicodeModeSwitches,true,bsDelphiUnicodeMode,[bsPointerMath]);
+    SetNonToken(tkgeneric);
+    end;
   'TP':
     SetMode(msTP7,TPModeSwitches,false);
   'MACPAS':
@@ -3672,6 +3680,8 @@ begin
           DoBoolDirective(bsAssertions);
         'DEFINE':
           HandleDefine(Param);
+        'GOTO':
+          DoBoolDirective(bsGoto);
         'ERROR':
           HandleError(Param);
         'HINT':
@@ -3786,9 +3796,9 @@ begin
     DoLog(mtWarning,nWarnIllegalCompilerDirectiveX,sWarnIllegalCompilerDirectiveX,
       [BoolSwitchNames[bs]])
   else if NewValue then
-    Include(FCurrentBoolSwitches,bs)
+    CurrentBoolSwitches:=CurrentBoolSwitches+[bs]
   else
-    Exclude(FCurrentBoolSwitches,bs);
+    CurrentBoolSwitches:=CurrentBoolSwitches-[bs];
 end;
 
 function TPascalScanner.DoFetchToken: TToken;
@@ -4508,9 +4518,24 @@ begin
 end;
 
 procedure TPascalScanner.SetCurrentBoolSwitches(const AValue: TBoolSwitches);
+var
+  OldBS, Removed, Added: TBoolSwitches;
 begin
   if FCurrentBoolSwitches=AValue then Exit;
+  OldBS:=FCurrentBoolSwitches;
   FCurrentBoolSwitches:=AValue;
+  Removed:=OldBS-FCurrentBoolSwitches;
+  Added:=FCurrentBoolSwitches-OldBS;
+  if bsGoto in Added then
+    begin
+    UnsetNonToken(tklabel);
+    UnsetNonToken(tkgoto);
+    end;
+  if bsGoto in Removed then
+    begin
+    SetNonToken(tklabel);
+    SetNonToken(tkgoto);
+    end;
 end;
 
 procedure TPascalScanner.SetCurrentModeSwitches(AValue: TModeSwitches);

packages/fcl-passrc/tests/tcexprparser.pas

@@ -109,6 +109,9 @@ type
     Procedure TestAPlusBBracketArrayParams;
     Procedure TestAPlusBBracketDotC;
     Procedure TestADotBDotC;
+    Procedure TestADotBBracketC;
+    Procedure TestSelfDotBBracketC;
+    Procedure TestAasBDotCBracketFuncParams;
     Procedure TestRange;
     Procedure TestBracketsTotal;
     Procedure TestBracketsLeft;
@@ -1249,6 +1252,70 @@ begin
   AssertExpression('right b',SubB.right,pekIdent,'b');
 end;
 
+procedure TTestExpressions.TestADotBBracketC;
+var
+  P: TParamsExpr;
+  B: TBinaryExpr;
+begin
+  ParseExpression('a.b[c]');
+  P:=TParamsExpr(AssertExpression('ArrayParams',TheExpr,pekArrayParams,TParamsExpr));
+
+  B:=TBinaryExpr(AssertExpression('Binary identifier',P.Value,pekBinary,TBinaryExpr));
+  AssertEquals('dot expr',eopSubIdent,B.OpCode);
+  TAssert.AssertSame('B.left.parent=B',B,B.left.Parent);
+  TAssert.AssertSame('B.right.parent=B',B,B.right.Parent);
+  AssertExpression('left a',B.left,pekIdent,'a');
+  AssertExpression('right b',B.right,pekIdent,'b');
+
+  AssertEquals('length(p.Params)',length(p.Params),1);
+  AssertExpression('first param c',p.Params[0],pekIdent,'c');
+end;
+
+procedure TTestExpressions.TestSelfDotBBracketC;
+var
+  P: TParamsExpr;
+  B: TBinaryExpr;
+begin
+  ParseExpression('self.b[c]');
+  P:=TParamsExpr(AssertExpression('ArrayParams',TheExpr,pekArrayParams,TParamsExpr));
+
+  B:=TBinaryExpr(AssertExpression('Binary identifier',P.Value,pekBinary,TBinaryExpr));
+  AssertEquals('dot expr',eopSubIdent,B.OpCode);
+  TAssert.AssertSame('B.left.parent=B',B,B.left.Parent);
+  TAssert.AssertSame('B.right.parent=B',B,B.right.Parent);
+  AssertEquals('left self',TSelfExpr,B.left.classtype);
+  AssertExpression('right b',B.right,pekIdent,'b');
+
+  AssertEquals('length(p.Params)',length(p.Params),1);
+  AssertExpression('first param c',p.Params[0],pekIdent,'c');
+end;
+
+procedure TTestExpressions.TestAasBDotCBracketFuncParams;
+var
+  P: TParamsExpr;
+  B, AsExpr: TBinaryExpr;
+begin
+  ParseExpression('(a as b).c(d)');
+  P:=TParamsExpr(AssertExpression('FuncParams',TheExpr,pekFuncParams,TParamsExpr));
+  AssertEquals('length(p.Params)',length(p.Params),1);
+  AssertExpression('first param d',p.Params[0],pekIdent,'d');
+
+  B:=TBinaryExpr(AssertExpression('Upper Binary identifier',P.Value,pekBinary,TBinaryExpr));
+  AssertEquals('dot c expr',eopSubIdent,B.OpCode);
+  TAssert.AssertSame('B.left.parent=B',B,B.left.Parent);
+  TAssert.AssertSame('B.right.parent=B',B,B.right.Parent);
+
+  AssertExpression('dot c',b.right,pekIdent,'c');
+
+  AsExpr:=TBinaryExpr(AssertExpression('lower binary identifier',B.left,pekBinary,TBinaryExpr));
+  AssertEquals('AS expr',eopAs,AsExpr.OpCode);
+  TAssert.AssertSame('AsExpr.left.parent=AsExpr',AsExpr,AsExpr.left.Parent);
+  TAssert.AssertSame('AsExpr.right.parent=AsExpr',AsExpr,AsExpr.right.Parent);
+
+  AssertExpression('left AS a',AsExpr.left,pekIdent,'a');
+  AssertExpression('right AS b',AsExpr.right,pekIdent,'b');
+end;
+
 initialization
 
   RegisterTest(TTestExpressions);

packages/fcl-passrc/tests/tcgenerics.pp

@@ -12,20 +12,21 @@ Type
   { TTestGenerics }
 
   TTestGenerics = Class(TBaseTestTypeParser)
-  private
   Published
     Procedure TestObjectGenerics;
     Procedure TestRecordGenerics;
     Procedure TestArrayGenerics;
+    Procedure TestGenericConstraint;
+    Procedure TestDeclarationConstraint;
     Procedure TestSpecializationDelphi;
-    procedure TestDeclarationConstraint;
     Procedure TestDeclarationDelphi;
     Procedure TestDeclarationDelphiSpecialize;
-    procedure TestDeclarationFPC;
+    Procedure TestDeclarationFPC;
     Procedure TestMethodImplementation;
     Procedure TestInlineSpecializationInArgument;
     Procedure TestSpecializeNested;
     Procedure TestInlineSpecializeInStatement;
+    Procedure TestGenericFunction; // ToDo
   end;
 
 implementation
@@ -61,20 +62,25 @@ begin
   ParseDeclarations;
 end;
 
-procedure TTestGenerics.TestSpecializationDelphi;
+procedure TTestGenerics.TestGenericConstraint;
 begin
-  ParseType('TFPGList<integer>',TPasSpecializeType,'');
+  Add([
+    'Type',
+    'Generic TSomeClass<T: TObject> = class',
+    '  b : T;',
+    'end;',
+    '']);
+  ParseDeclarations;
 end;
 
-procedure TTestGenerics.TestDeclarationDelphi;
+procedure TTestGenerics.TestDeclarationConstraint;
 Var
   T : TPasClassType;
 begin
   Scanner.CurrentModeSwitches:=[msDelphi]+Scanner.CurrentModeSwitches ;
   Source.Add('Type');
-  Source.Add('  TSomeClass<T,T2> = Class(TObject)');
+  Source.Add('  TSomeClass<T: T2> = Class(TObject)');
   Source.Add('  b : T;');
-  Source.Add('  b2 : T2;');
   Source.Add('end;');
   ParseDeclarations;
   AssertNotNull('have generic definition',Declarations.Classes);
@@ -82,18 +88,23 @@ begin
   AssertEquals('Pascal class',TPasClassType,TObject(Declarations.Classes[0]).ClassType);
   T:=TPasClassType(Declarations.Classes[0]);
   AssertNotNull('have generic templates',T.GenericTemplateTypes);
-  AssertEquals('2 template types',2,T.GenericTemplateTypes.Count);
+  AssertEquals('1 template types',1,T.GenericTemplateTypes.Count);
   AssertSame('Parent 0 is class',T,TPasElement(T.GenericTemplateTypes[0]).Parent);
-  AssertSame('Parent 1 is class',T,TPasElement(T.GenericTemplateTypes[1]).Parent);
+  AssertEquals('Type constraint is recorded','T2',TPasGenericTemplateType(T.GenericTemplateTypes[0]).TypeConstraint);
 end;
 
-procedure TTestGenerics.TestDeclarationFPC;
+procedure TTestGenerics.TestSpecializationDelphi;
+begin
+  ParseType('TFPGList<integer>',TPasSpecializeType,'');
+end;
+
+procedure TTestGenerics.TestDeclarationDelphi;
 Var
   T : TPasClassType;
 begin
   Scanner.CurrentModeSwitches:=[msDelphi]+Scanner.CurrentModeSwitches ;
   Source.Add('Type');
-  Source.Add('  TSomeClass<T;T2> = Class(TObject)');
+  Source.Add('  TSomeClass<T,T2> = Class(TObject)');
   Source.Add('  b : T;');
   Source.Add('  b2 : T2;');
   Source.Add('end;');
@@ -108,34 +119,35 @@ begin
   AssertSame('Parent 1 is class',T,TPasElement(T.GenericTemplateTypes[1]).Parent);
 end;
 
-
-procedure TTestGenerics.TestDeclarationConstraint;
+procedure TTestGenerics.TestDeclarationDelphiSpecialize;
 Var
   T : TPasClassType;
 begin
   Scanner.CurrentModeSwitches:=[msDelphi]+Scanner.CurrentModeSwitches ;
   Source.Add('Type');
-  Source.Add('  TSomeClass<T: T2> = Class(TObject)');
+  Source.Add('  TSomeClass<T,T2> = Class(TSomeGeneric<Integer,Integer>)');
   Source.Add('  b : T;');
+  Source.Add('  b2 : T2;');
   Source.Add('end;');
   ParseDeclarations;
   AssertNotNull('have generic definition',Declarations.Classes);
   AssertEquals('have generic definition',1,Declarations.Classes.Count);
   AssertEquals('Pascal class',TPasClassType,TObject(Declarations.Classes[0]).ClassType);
   T:=TPasClassType(Declarations.Classes[0]);
+  AssertEquals('Name is correct','TSomeClass',T.Name);
   AssertNotNull('have generic templates',T.GenericTemplateTypes);
-  AssertEquals('1 template types',1,T.GenericTemplateTypes.Count);
+  AssertEquals('2 template types',2,T.GenericTemplateTypes.Count);
   AssertSame('Parent 0 is class',T,TPasElement(T.GenericTemplateTypes[0]).Parent);
-  AssertEquals('Type constraint is recorded','T2',TPasGenericTemplateType(T.GenericTemplateTypes[0]).TypeConstraint);
+  AssertSame('Parent 1 is class',T,TPasElement(T.GenericTemplateTypes[1]).Parent);
 end;
 
-procedure TTestGenerics.TestDeclarationDelphiSpecialize;
+procedure TTestGenerics.TestDeclarationFPC;
 Var
   T : TPasClassType;
 begin
-  Scanner.CurrentModeSwitches:=[msDelphi]+Scanner.CurrentModeSwitches ;
+  Scanner.CurrentModeSwitches:=[msDelphi]+Scanner.CurrentModeSwitches;
   Source.Add('Type');
-  Source.Add('  TSomeClass<T,T2> = Class(TSomeGeneric<Integer,Integer>)');
+  Source.Add('  TSomeClass<T;T2> = Class(TObject)');
   Source.Add('  b : T;');
   Source.Add('  b2 : T2;');
   Source.Add('end;');
@@ -144,7 +156,6 @@ begin
   AssertEquals('have generic definition',1,Declarations.Classes.Count);
   AssertEquals('Pascal class',TPasClassType,TObject(Declarations.Classes[0]).ClassType);
   T:=TPasClassType(Declarations.Classes[0]);
-  AssertEquals('Name is correct','TSomeClass',T.Name);
   AssertNotNull('have generic templates',T.GenericTemplateTypes);
   AssertEquals('2 template types',2,T.GenericTemplateTypes.Count);
   AssertSame('Parent 0 is class',T,TPasElement(T.GenericTemplateTypes[0]).Parent);
@@ -206,6 +217,18 @@ begin
   ParseModule;
 end;
 
+procedure TTestGenerics.TestGenericFunction;
+begin
+  Add([
+  'generic function IfThen<T>(val:boolean;const iftrue:T; const iffalse:T) :T; inline; overload;',
+  'begin',
+  'end;',
+  'begin',
+  //'  specialize IfThen<word>(true,2,3);',
+  '']);
+  ParseModule;
+end;
+
 initialization
   RegisterTest(TTestGenerics);
 end.

packages/fcl-passrc/tests/tcprocfunc.pas

@@ -1273,18 +1273,20 @@ procedure TTestProcedureFunction.TestOperatorNames;
 
 Var
   t : TOperatorType;
+  S: String;
 
 begin
   For t:=Succ(otUnknown) to High(TOperatorType) do
       begin
+      S:=GetEnumName(TypeInfo(TOperatorType),Ord(T));
       ResetParser;
       if t in UnaryOperators then
         AddDeclaration(Format('operator %s (a: Integer) : te',[OperatorNames[t]]))
       else
         AddDeclaration(Format('operator %s (a: Integer; b: integer) : te',[OperatorNames[t]]));
       ParseOperator;
-      AssertEquals('Token based',False,FOperator.TokenBased);
-      AssertEquals('Correct operator type',T,FOperator.OperatorType);
+      AssertEquals(S+': Token based',t in [otIn],FOperator.TokenBased);
+      AssertEquals(S+': Correct operator type',T,FOperator.OperatorType);
       if t in UnaryOperators then
         AssertEquals('Correct operator name',format('%s(Integer):te',[OperatorNames[t]]),FOperator.Name)
       else

packages/fcl-passrc/tests/tcstatements.pas

@@ -1794,7 +1794,9 @@ end;
 procedure TTestStatementParser.TestGotoInIfThen;
 
 begin
-  AddStatements(['if expr then',
+  AddStatements([
+  '{$goto on}',
+  'if expr then',
   '  dosomething',
   '   else if expr2 then',
   '    goto try_qword',

packages/fcl-passrc/tests/tcuseanalyzer.pas

@@ -164,6 +164,10 @@ type
     procedure TestWP_ClassInterface_COM_Unit;
     procedure TestWP_ClassInterface_Typeinfo;
     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;
@@ -3061,6 +3065,145 @@ begin
   AnalyzeWholeProgram;
 end;
 
+procedure TTestUseAnalyzer.TestWP_ClassHelper;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  {#TObject_used}TObject = class',
+  '  end;',
+  '  {#TBird_used}TBird = class',
+  '    {#TBird_A_notused}A: word;',
+  '  end;',
+  '  {#TAnt_used}TAnt = class',
+  '    {#TAnt_B_notused}B: word;',
+  '  type',
+  '    {#TMouth_used}TMouth = class',
+  '      {#TMouth_C_notused}C: word;',
+  '    type',
+  '      {#TBirdHelper_used}TBirdHelper = class helper for TBird',
+  '        procedure {#TBirdHelper_Fly_used}Fly;',
+  '      end;',
+  '    end;',
+  '  end;',
+  'procedure TAnt.TMouth.TBirdHelper.Fly;',
+  'begin',
+  'end;',
+  'var b: TBird;',
+  'begin',
+  '  b.Fly;;',
+  '']);
+  AnalyzeWholeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestWP_ClassHelper_ClassConstrucor_Used;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  {#TObject_used}TObject = class',
+  '    class constructor {#TObject_Init_used}Init;',
+  '    class destructor {#TObject_Done_used}Done;',
+  '  end;',
+  '  {#TBird_used}TBird = class',
+  '    {#TBird_A_notused}A: word;',
+  '    class constructor {#TBird_Init_used}Init;',
+  '    class destructor {#TBird_Done_used}Done;',
+  '  end;',
+  '  {#TBirdHelper_used}TBirdHelper = class helper for TBird',
+  '    procedure {#TBirdHelper_Fly_used}Fly;',
+  '    class constructor {#TBirdHelper_Init_used}Init;',
+  '    class destructor {#TBirdHelper_Done_used}Done;',
+  '  end;',
+  '  TAnt = class',
+  '    class constructor {#TAnt_Init_notused}Init;',
+  '    class destructor {#TAnt_Done_notused}Done;',
+  '  end;',
+  'class constructor TObject.Init;',
+  'begin',
+  'end;',
+  'class destructor TObject.Done;',
+  'begin',
+  'end;',
+  'class constructor TBird.Init;',
+  'begin',
+  'end;',
+  'class destructor TBird.Done;',
+  'begin',
+  'end;',
+  'procedure TBirdHelper.Fly;',
+  'begin',
+  'end;',
+  'class constructor TBirdHelper.Init;',
+  'begin',
+  'end;',
+  'class destructor TBirdHelper.Done;',
+  'begin',
+  'end;',
+  'class constructor TAnt.Init;',
+  'begin',
+  'end;',
+  'class destructor TAnt.Done;',
+  'begin',
+  'end;',
+  'var b: TBird;',
+  'begin',
+  '  b.Fly;',
+  '']);
+  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/pastojs/fpmake.pp

@@ -55,6 +55,7 @@ begin
       T.Dependencies.AddInclude('pas2jsfileutilswin.inc',AllWindowsOSes);
     T:=P.Targets.AddUnit('pas2jslogger.pp');
     T:=P.Targets.AddUnit('pas2jspparser.pp');
+    T:=P.Targets.AddUnit('pas2jsuseanalyzer.pp');
     T:=P.Targets.AddUnit('pas2jscompiler.pp');
     T:=P.Targets.AddUnit('pas2jsfscompiler.pp');
       T.Dependencies.AddUnit('pas2jscompiler');

packages/pastojs/src/pas2jscompiler.pp

@@ -38,12 +38,12 @@ uses
   // !! No filesystem units here.
   Classes, SysUtils, contnrs,
   jsbase, jstree, jswriter, JSSrcMap,
-  PScanner, PParser, PasTree, PasResolver, PasUseAnalyzer, PasResolveEval,
-  FPPas2Js, FPPJsSrcMap, Pas2jsLogger, Pas2jsFS, Pas2jsPParser;
+  PScanner, PParser, PasTree, PasResolver, PasResolveEval, PasUseAnalyzer,
+  FPPas2Js, FPPJsSrcMap, Pas2jsLogger, Pas2jsFS, Pas2jsPParser, Pas2jsUseAnalyzer;
 
 const
   VersionMajor = 1;
-  VersionMinor = 3;
+  VersionMinor = 5;
   VersionRelease = 1;
   VersionExtra = '';
   DefaultConfigFile = 'pas2js.cfg';
@@ -136,6 +136,7 @@ type
     // source map
     coSourceMapCreate,
     coSourceMapInclude,
+    coSourceMapFilenamesAbsolute,
     coSourceMapXSSIHeader
     );
   TP2jsCompilerOptions = set of TP2jsCompilerOption;
@@ -184,6 +185,7 @@ const
     'Keep not used declarations (WPO)',
     'Create source map',
     'Include Pascal sources in source map',
+    'Do not shorten filenames in source map',
     'Prepend XSSI protection )]} to source map'
     );
 
@@ -344,7 +346,7 @@ type
     FScanner: TPas2jsPasScanner;
     FShowDebug: boolean;
     FUnitFilename: string;
-    FUseAnalyzer: TPasAnalyzer;
+    FUseAnalyzer: TPas2JSAnalyzer;
     FUsedBy: array[TUsedBySection] of TFPList; // list of TPas2jsCompilerFile
     function GetUsedBy(Section: TUsedBySection; Index: integer): TPas2jsCompilerFile;
     function GetUsedByCount(Section: TUsedBySection): integer;
@@ -411,7 +413,7 @@ type
     property Scanner: TPas2jsPasScanner read FScanner;
     property ShowDebug: boolean read FShowDebug write FShowDebug;
     property UnitFilename: string read FUnitFilename;
-    property UseAnalyzer: TPasAnalyzer read FUseAnalyzer; // unit analysis
+    property UseAnalyzer: TPas2JSAnalyzer read FUseAnalyzer; // unit analysis
     property UsedByCount[Section: TUsedBySection]: integer read GetUsedByCount;
     property UsedBy[Section: TUsedBySection; Index: integer]: TPas2jsCompilerFile read GetUsedBy;
   end;
@@ -452,11 +454,6 @@ type
     property Compiler:  TPas2jsCompiler Read FCompiler;
   end;
 
-  { TPas2JSWPOptimizer }
-
-  TPas2JSWPOptimizer = class(TPasAnalyzer)
-  end;
-
   { TPas2jsCompiler }
 
   TPas2jsCompiler = class
@@ -482,7 +479,7 @@ type
     FParamMacros: TPas2jsMacroEngine;
     FSrcMapSourceRoot: string;
     FUnits: TPasAnalyzerKeySet; // set of TPas2jsCompilerFile, key is PasUnitName
-    FWPOAnalyzer: TPas2JSWPOptimizer;
+    FWPOAnalyzer: TPas2JSAnalyzer;
     FInterfaceType: TPasClassInterfaceType;
     FPrecompileGUID: TGUID;
     FInsertFilenames: TStringList;
@@ -505,6 +502,7 @@ type
     function GetSkipDefaultConfig: Boolean; inline;
     function GetSrcMapEnable: boolean;
     function GetSrcMapInclude: boolean;
+    function GetSrcMapFilenamesAbsolute: boolean;
     function GetSrcMapXSSIHeader: boolean;
     function GetTargetPlatform: TPasToJsPlatform;
     function GetTargetProcessor: TPasToJsProcessor;
@@ -532,6 +530,7 @@ type
     procedure SetSrcMapBaseDir(const AValue: string);
     procedure SetSrcMapEnable(const AValue: boolean);
     procedure SetSrcMapInclude(const AValue: boolean);
+    procedure SetSrcMapFilenamesAbsolute(const AValue: boolean);
     procedure SetSrcMapXSSIHeader(const AValue: boolean);
     procedure SetTargetPlatform(const AValue: TPasToJsPlatform);
     procedure SetTargetProcessor(const AValue: TPasToJsProcessor);
@@ -560,7 +559,7 @@ type
     function CreateLog: TPas2jsLogger; virtual;
     function CreateMacroEngine: TPas2jsMacroEngine;virtual;
     function CreateSrcMap(const aFileName: String): TPas2JSSrcMap; virtual;
-    function CreateOptimizer: TPas2JSWPOptimizer;
+    function CreateOptimizer: TPas2JSAnalyzer;
     // These are mandatory !
     function CreateSetOfCompilerFiles(keyType: TKeyCompareType): TPasAnalyzerKeySet; virtual; abstract;
     function CreateFS: TPas2JSFS; virtual; abstract;
@@ -573,7 +572,7 @@ type
     // Command-line option handling
     procedure HandleOptionPCUFormat(aValue: String); virtual;
     function HandleOptionPaths(C: Char; aValue: String; FromCmdLine: Boolean): Boolean; virtual;
-    function HandleOptionJS(C: Char; aValue: String; Quick,FromCmdLine: Boolean): Boolean; virtual;
+    function HandleOptionJ(C: Char; aValue: String; Quick,FromCmdLine: Boolean): Boolean; virtual;
     procedure HandleOptionConfigFile(aPos: Integer; const aFileName: string); virtual;
     procedure HandleOptionInfo(aValue: string);
     // DoWriteJSFile: return false to use the default write function.
@@ -629,7 +628,7 @@ type
     function IsDefined(const aName: String): boolean;
     procedure SetOption(Flag: TP2jsCompilerOption; Enable: boolean);
 
-    function GetUnitInfo(const UseUnitName, InFileName: String;
+    function GetUnitInfo(const UseUnitName, InFileName, ModuleDir: String;
       PCUSupport: TPCUSupport): TFindUnitInfo;
     function FindFileWithUnitFilename(UnitFilename: string): TPas2jsCompilerFile;
     procedure LoadModuleFile(UnitFilename, UseUnitName: string;
@@ -659,6 +658,7 @@ type
     property SrcMapSourceRoot: string read FSrcMapSourceRoot write FSrcMapSourceRoot;
     property SrcMapInclude: boolean read GetSrcMapInclude write SetSrcMapInclude;
     property SrcMapXSSIHeader: boolean read GetSrcMapXSSIHeader write SetSrcMapXSSIHeader;
+    property SrcMapFilenamesAbsolute: boolean read GetSrcMapFilenamesAbsolute write SetSrcMapFilenamesAbsolute;
     property ShowDebug: boolean read GetShowDebug write SetShowDebug;
     property ShowFullPaths: boolean read GetShowFullPaths write SetShowFullPaths;
     property ShowLogo: Boolean read GetShowLogo write SetShowLogo;
@@ -667,7 +667,7 @@ type
     property SkipDefaultConfig: Boolean read GetSkipDefaultConfig write SetSkipDefaultConfig;
     property TargetPlatform: TPasToJsPlatform read GetTargetPlatform write SetTargetPlatform;
     property TargetProcessor: TPasToJsProcessor read GetTargetProcessor write SetTargetProcessor;
-    property WPOAnalyzer: TPas2JSWPOptimizer read FWPOAnalyzer; // Whole Program Optimization
+    property WPOAnalyzer: TPas2JSAnalyzer read FWPOAnalyzer; // Whole Program Optimization
     property WriteDebugLog: boolean read GetWriteDebugLog write SetWriteDebugLog;
     property WriteMsgToStdErr: boolean read GetWriteMsgToStdErr write SetWriteMsgToStdErr;
     property AllJSIntoMainJS: Boolean Read FAllJSIntoMainJS Write SetAllJSIntoMainJS;
@@ -683,9 +683,6 @@ type
     property PostProcessorSupport: TPas2JSPostProcessorSupport Read FPostProcessorSupport Write FPostProcessorSupport;
   end;
 
-
-
-
 function GetCompiledDate: string;
 function GetCompiledVersion: string;
 function GetCompiledTargetOS: string;
@@ -934,7 +931,7 @@ begin
   for ub in TUsedBySection do
     FUsedBy[ub]:=TFPList.Create;
 
-  FUseAnalyzer:=TPasAnalyzer.Create;
+  FUseAnalyzer:=TPas2JSAnalyzer.Create;
   FUseAnalyzer.OnMessage:=@OnUseAnalyzerMessage;
   FUseAnalyzer.Resolver:=FPasResolver;
 
@@ -1622,6 +1619,7 @@ var
   aFile: TPas2jsCompilerFile;
   UnitInfo: TFindUnitInfo;
   LoadInfo: TLoadUnitInfo;
+  ModuleDir: String;
 begin
   Result:=nil;
   aFile:=Nil;
@@ -1629,7 +1627,8 @@ begin
   if CompareText(ExtractFilenameOnly(UnitFilename),UseUnitname)=0 then
     Parser.RaiseParserError(nUnitCycle,[UseUnitname]);
 
-  UnitInfo:=Compiler.GetUnitInfo(UseUnitName,InFileName,PCUSupport);
+  ModuleDir:=ExtractFilePath(PasFileName);
+  UnitInfo:=Compiler.GetUnitInfo(UseUnitName,InFileName,ModuleDir,PCUSupport);
   if UnitInfo.FileName<>'' then
     begin
     LoadInfo.UseFilename:=UnitInfo.FileName;
@@ -1655,8 +1654,6 @@ begin
   // if Result=nil resolver will give a nice error position, so don't do it here
 end;
 
-
-
 { TPas2jsCompiler }
 
 procedure TPas2jsCompiler.SetFS(AValue: TPas2jsFS);
@@ -1936,10 +1933,10 @@ begin
   Result:=aFile.NeedBuild;
 end;
 
-function TPas2jsCompiler.CreateOptimizer: TPas2JSWPOptimizer;
+function TPas2jsCompiler.CreateOptimizer: TPas2JSAnalyzer;
 
 begin
-  Result:=TPas2JSWPOptimizer.Create;
+  Result:=TPas2JSAnalyzer.Create;
 end;
 
 procedure TPas2jsCompiler.OptimizeProgram(aFile: TPas2jsCompilerFile);
@@ -2009,7 +2006,8 @@ begin
       SrcMap.SourceContents[i]:=aFile.Source;
     end;
     // translate local file name
-    if BaseDir<>'' then
+    MapFilename:=LocalFilename;
+    if (BaseDir<>'') and not SrcMapFilenamesAbsolute then
     begin
       if not FS.TryCreateRelativePath(LocalFilename,BaseDir,true,MapFilename) then
       begin
@@ -2024,12 +2022,14 @@ begin
         // the source is included, do not translate the filename
         MapFilename:=LocalFilename;
       end;
-      {$IFNDEF Unix}
-      // use / as PathDelim
+    end;
+    {$IFNDEF Unix}
+    // use / as PathDelim
+    if PathDelim<>'/' then
       MapFilename:=StringReplace(MapFilename,PathDelim,'/',[rfReplaceAll]);
-      {$ENDIF}
+    {$ENDIF}
+    if LocalFilename<>MapFilename then
       SrcMap.SourceTranslatedFiles[i]:=MapFilename;
-    end;
   end;
 end;
 
@@ -2483,6 +2483,11 @@ begin
   Result:=coSourceMapInclude in FOptions;
 end;
 
+function TPas2jsCompiler.GetSrcMapFilenamesAbsolute: boolean;
+begin
+  Result:=coSourceMapFilenamesAbsolute in FOptions;
+end;
+
 function TPas2jsCompiler.GetSrcMapXSSIHeader: boolean;
 begin
   Result:=coSourceMapXSSIHeader in FOptions;
@@ -2588,6 +2593,11 @@ begin
   SetOption(coSourceMapInclude,AValue);
 end;
 
+procedure TPas2jsCompiler.SetSrcMapFilenamesAbsolute(const AValue: boolean);
+begin
+  SetOption(coSourceMapFilenamesAbsolute,AValue);
+end;
+
 procedure TPas2jsCompiler.SetSrcMapXSSIHeader(const AValue: boolean);
 begin
   SetOption(coSourceMapXSSIHeader,AValue);
@@ -3010,7 +3020,7 @@ begin
 
 end;
 
-function TPas2jsCompiler.HandleOptionJS(C: Char; aValue: String;
+function TPas2jsCompiler.HandleOptionJ(C: Char; aValue: String;
   Quick, FromCmdLine: Boolean): Boolean;
 
 Var
@@ -3084,6 +3094,10 @@ begin
         SrcMapInclude:=true;
       'include-':
         SrcMapInclude:=false;
+      'absolute':
+        SrcMapFilenamesAbsolute:=true;
+      'absolute-':
+        SrcMapFilenamesAbsolute:=false;
       'xssiheader':
         SrcMapXSSIHeader:=true;
       'xssiheader-':
@@ -3092,7 +3106,7 @@ begin
         begin
         i:=Pos('=',aValue);
         if i<1 then
-          result:=false
+          ParamFatal('unknown -Jm parameter "'+aValue+'"')
         else
           begin
           S:=LeftStr(aValue,i-1);
@@ -3101,7 +3115,7 @@ begin
             'sourceroot': SrcMapSourceRoot:=aValue;
             'basedir': SrcMapBaseDir:=aValue;
           else
-            Result:=False;
+            ParamFatal('unknown -Jm parameter "'+s+'"')
           end;
           end;
         end;
@@ -3403,7 +3417,7 @@ begin
             UnknownParam;
           c:=aValue[1];
           Delete(aValue,1,1);
-          if not HandleOptionJS(c,aValue,Quick,FromCmdLine) then
+          if not HandleOptionJ(c,aValue,Quick,FromCmdLine) then
             UnknownParam;
         end;
       'M': // syntax mode
@@ -4214,8 +4228,9 @@ begin
   w('   -Jl   : lower case identifiers');
   w('   -Jm   : generate source maps');
   w('     -Jmsourceroot=<x>: use x as "sourceRoot", prefix URL for source file names.');
-  w('     -Jmbasedir=<x>: write source file names relative to directory x.');
+  w('     -Jmbasedir=<x>: write source file names relative to directory x, default is map file folder.');
   w('     -Jminclude: include Pascal sources in source map.');
+  w('     -Jmabsolute: store absolute filenames, not relative.');
   w('     -Jmxssiheader: start source map with XSSI protection )]}'', default.');
   w('     -Jm-: disable generating source maps');
   w('   -Jo<x>: Enable or disable extra option. The x is case insensitive:');
@@ -4637,8 +4652,8 @@ begin
   Result:=FMainJSFileResolved;
 end;
 
-function TPas2jsCompiler.GetUnitInfo(const UseUnitName, InFileName: String;
-  PCUSupport: TPCUSupport): TFindUnitInfo;
+function TPas2jsCompiler.GetUnitInfo(const UseUnitName, InFileName,
+  ModuleDir: String; PCUSupport: TPCUSupport): TFindUnitInfo;
 
 var
   FoundPasFilename, FoundPasUnitName: string;
@@ -4667,7 +4682,7 @@ var
         end;
       end else begin
         // search pas in unit path
-        FoundPasFilename:=FS.FindUnitFileName(TestUnitName,'',FoundPasIsForeign);
+        FoundPasFilename:=FS.FindUnitFileName(TestUnitName,'',ModuleDir,FoundPasIsForeign);
         if FoundPasFilename<>'' then
           FoundPasUnitName:=TestUnitName;
       end;
@@ -4725,7 +4740,7 @@ begin
     end;
   end else begin
     // search Pascal file with InFilename
-    FoundPasFilename:=FS.FindUnitFileName(UseUnitname,InFilename,FoundPasIsForeign);
+    FoundPasFilename:=FS.FindUnitFileName(UseUnitname,InFilename,ModuleDir,FoundPasIsForeign);
     if FoundPasFilename='' then
       exit; // an in-filename unit source is missing -> stop
     FoundPasUnitName:=ExtractFilenameOnly(InFilename);

packages/pastojs/src/pas2jsfilecache.pp

@@ -256,7 +256,7 @@ type
     function SearchLowUpCase(var Filename: string): boolean;
     function FindCustomJSFileName(const aFilename: string): String; override;
     function FindUnitJSFileName(const aUnitFilename: string): String; override;
-    function FindUnitFileName(const aUnitname, InFilename: string; out IsForeign: boolean): String; override;
+    function FindUnitFileName(const aUnitname, InFilename, ModuleDir: string; out IsForeign: boolean): String; override;
     function FindIncludeFileName(const aFilename: string): String; override;
     function AddIncludePaths(const Paths: string; FromCmdLine: boolean; out ErrorMsg: string): boolean;
     function AddUnitPaths(const Paths: string; FromCmdLine: boolean; out ErrorMsg: string): boolean;
@@ -1805,10 +1805,11 @@ begin
   AddSrcUnitPaths(aValue,FromCmdLine,Result);
 end;
 
-function TPas2jsFilesCache.TryCreateRelativePath(const Filename, BaseDirectory: String; UsePointDirectory: boolean; out
-  RelPath: String): Boolean;
+function TPas2jsFilesCache.TryCreateRelativePath(const Filename, BaseDirectory: String;
+  UsePointDirectory: boolean; out RelPath: String): Boolean;
 begin
-  Result:=Pas2jsFileUtils.TryCreateRelativePath(Filename, BaseDirectory, UsePointDirectory, RelPath);
+  Result:=Pas2jsFileUtils.TryCreateRelativePath(Filename, BaseDirectory,
+    UsePointDirectory, true, RelPath);
 end;
 
 function TPas2jsFilesCache.FindIncludeFileName(const aFilename: string): String;
@@ -1888,7 +1889,8 @@ begin
 end;
 
 
-function TPas2jsFilesCache.FindUnitFileName(const aUnitname, InFilename: string; out IsForeign: boolean): String;
+function TPas2jsFilesCache.FindUnitFileName(const aUnitname, InFilename,
+  ModuleDir: string; out IsForeign: boolean): String;
 var
   SearchedDirs: TStringList;
 
@@ -1924,7 +1926,7 @@ begin
         if SearchLowUpCase(Result) then exit;
       end else
       begin
-        Result:=ResolveDots(BaseDirectory+Result);
+        Result:=ResolveDots(ModuleDir+Result);
         if SearchLowUpCase(Result) then exit;
       end;
       exit('');
@@ -1939,6 +1941,10 @@ begin
         exit;
       end;
 
+    // then in ModuleDir
+    IsForeign:=false;
+    if SearchInDir(ModuleDir,Result) then exit;
+
     // then in BaseDirectory
     IsForeign:=false;
     if SearchInDir(BaseDirectory,Result) then exit;

packages/pastojs/src/pas2jsfiler.pp

@@ -71,13 +71,16 @@ uses
 
 const
   PCUMagic = 'Pas2JSCache';
-  PCUVersion = 3;
+  PCUVersion = 5;
   { Version Changes:
     1: initial version
     2: - TPasProperty.ImplementsFunc:String -> Implements:TPasExprArray
        - pcsfAncestorResolved
        - removed msIgnoreInterfaces
-    3: changed records from function to objects
+    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';
@@ -168,9 +171,9 @@ const
     'ArrayOperators',
     'ExternalClass',
     'PrefixedAttributes',
-    'IgnoreAttributes',
-    'OmitRTTI'
-    );
+    'OmitRTTI',
+    'MultipleScopeHelpers'
+    ); // Dont forget to update ModeSwitchToInt !
 
   PCUDefaultBoolSwitches: TBoolSwitches = [
     bsHints,
@@ -206,7 +209,8 @@ const
     'Macro',
     'ScopedEnums',
     'ObjectChecks',
-    'PointerMath'
+    'PointerMath',
+    'Goto'
     );
 
   PCUDefaultConverterOptions: TPasToJsConverterOptions = [coUseStrict];
@@ -348,7 +352,6 @@ const
     'Object',
     'Class',
     'Interface',
-    'Generic',
     'ClassHelper',
     'RecordHelper',
     'TypeHelper',
@@ -777,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;
@@ -859,11 +863,15 @@ type
     procedure Set_ModScope_AssertMsgConstructor(RefEl: TPasElement; Data: TObject);
     procedure Set_ModScope_RangeErrorClass(RefEl: TPasElement; Data: TObject);
     procedure Set_ModScope_RangeErrorConstructor(RefEl: TPasElement; Data: TObject);
+    procedure Set_ModScope_SystemTVarRec(RefEl: TPasElement; Data: TObject);
+    procedure Set_ModScope_SystemVarRecs(RefEl: TPasElement; Data: TObject);
     procedure Set_EnumTypeScope_CanonicalSet(RefEl: TPasElement; Data: TObject);
     procedure Set_PropertyScope_AncestorProp(RefEl: TPasElement; Data: TObject);
     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;
@@ -989,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
@@ -1383,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;
 
@@ -2510,6 +2521,8 @@ begin
   AddReferenceToObj(Obj,'AssertMsgConstructor',Scope.AssertMsgConstructor);
   AddReferenceToObj(Obj,'RangeErrorClass',Scope.RangeErrorClass);
   AddReferenceToObj(Obj,'RangeErrorConstructor',Scope.RangeErrorConstructor);
+  AddReferenceToObj(Obj,'SystemTVarRec',Scope.SystemTVarRec);
+  AddReferenceToObj(Obj,'SystemVarRecs',Scope.SystemVarRecs);
   WritePasScope(Obj,Scope,aContext);
 end;
 
@@ -2636,6 +2649,9 @@ begin
   WriteIdentifierScope(Obj,Scope,aContext);
 
   // not needed: Scope ElevatedLocals
+  // not needed: Scope Helpers
+  if (length(Scope.Helpers)>0) and not (Scope.Element is TInterfaceSection) then
+    RaiseMsg(20190119122007,Section);
 
   WriteDeclarations(Obj,Section,aContext);
   if Section is TInterfaceSection then
@@ -2780,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
@@ -2956,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}
@@ -3009,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
@@ -3016,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;
 
@@ -3711,7 +3752,7 @@ begin
     RaiseMsg(20180219135933,Scope.Element);
   AddReferenceToObj(Obj,'ImplProc',Scope.ImplProc);
   AddReferenceToObj(Obj,'Overridden',Scope.OverriddenProc);
-  // ClassScope: TPasClassScope; auto derived
+  // ClassOrRecordScope: TPasClassScope; auto derived
   if Scope.SelfArg<>nil then
     RaiseMsg(20180211180457,Scope.Element); // SelfArg only valid for method implementation
   // Mode: TModeSwitch: auto derived
@@ -3733,8 +3774,7 @@ begin
   WritePasElement(Obj,El,aContext);
   Scope:=El.CustomData as TPas2JSProcedureScope;
   //writeln('TPCUWriter.WriteProcedure ',GetObjName(El),' ',GetObjName(Scope),' ',Resolver.GetElementSourcePosStr(El));
-  // BEWARE: Scope can be nil for ignored methods of an interface (msIgnoreInterfaces)
-  if (Scope=nil) or (Scope.DeclarationProc=nil) then
+  if Scope.DeclarationProc=nil then
     begin
     WriteElementProperty(Obj,El,'ProcType',El.ProcType,aContext);
     WriteExpr(Obj,El,'Public',El.PublicName,aContext);
@@ -3752,12 +3792,6 @@ begin
       if El.MessageType<>pmtInteger then
         Obj.Add('MessageType',PCUProcedureMessageTypeNames[El.MessageType]);
       end;
-
-    if Scope=nil then
-      begin
-      Obj.Add('Scope',false); // msIgnoreInterfaces
-      exit;
-      end;
     WriteProcedureScope(Obj,Scope,aContext);
     end
   else
@@ -3803,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);
 
@@ -4402,6 +4443,28 @@ begin
     RaiseMsg(20180211123100,Scope.Element,GetObjName(RefEl));
 end;
 
+procedure TPCUReader.Set_ModScope_SystemTVarRec(RefEl: TPasElement;
+  Data: TObject);
+var
+  Scope: TPas2JSModuleScope absolute Data;
+begin
+  if RefEl is TPasRecordType then
+    Scope.SystemTVarRec:=TPasRecordType(RefEl)
+  else
+    RaiseMsg(20190215230826,Scope.Element,GetObjName(RefEl));
+end;
+
+procedure TPCUReader.Set_ModScope_SystemVarRecs(RefEl: TPasElement;
+  Data: TObject);
+var
+  Scope: TPas2JSModuleScope absolute Data;
+begin
+  if RefEl is TPasFunction then
+    Scope.SystemVarRecs:=TPasFunction(RefEl)
+  else
+    RaiseMsg(20190215230857,Scope.Element,GetObjName(RefEl));
+end;
+
 procedure TPCUReader.Set_EnumTypeScope_CanonicalSet(RefEl: TPasElement;
   Data: TObject);
 var
@@ -4460,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;
@@ -4881,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+'"');
@@ -5401,6 +5486,7 @@ procedure TPCUReader.ReadSectionScope(Obj: TJSONObject;
 begin
   ReadIdentifierScope(Obj,Scope,aContext);
   // not needed: Scope ElevatedLocals
+  // not needed: Scope Helpers, autogenerated in ReadClassType
   Scope.BoolSwitches:=ReadBoolSwitches(Obj,Scope.Element,'BoolSwitches',aContext.BoolSwitches);
   Scope.ModeSwitches:=ReadModeSwitches(Obj,Scope.Element,'ModeSwitches',aContext.ModeSwitches);
 end;
@@ -5696,7 +5782,6 @@ begin
     'Object': CreateClassType(okObject,Name);
     'Class': CreateClassType(okClass,Name);
     'Interface': CreateClassType(okInterface,Name);
-    'Generic': CreateClassType(okGeneric,Name);
     'ClassHelper': CreateClassType(okClassHelper,Name);
     'RecordHelper': CreateClassType(okRecordHelper,Name);
     'TypeHelper': CreateClassType(okTypeHelper,Name);
@@ -5761,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;
@@ -5944,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;
@@ -6265,6 +6365,8 @@ begin
   ReadElementReference(Obj,Scope,'AssertMsgConstructor',@Set_ModScope_AssertMsgConstructor);
   ReadElementReference(Obj,Scope,'RangeErrorClass',@Set_ModScope_RangeErrorClass);
   ReadElementReference(Obj,Scope,'RangeErrorConstructor',@Set_ModScope_RangeErrorConstructor);
+  ReadElementReference(Obj,Scope,'SystemTVarRec',@Set_ModScope_SystemTVarRec);
+  ReadElementReference(Obj,Scope,'SystemVarRecs',@Set_ModScope_SystemVarRecs);
   ReadPasScope(Obj,Scope,aContext);
 end;
 
@@ -6925,6 +7027,8 @@ var
   Data: TJSONData;
   Scope: TPas2JSClassScope;
   Ref: TResolvedReference;
+  Parent: TPasElement;
+  SectionScope: TPasSectionScope;
 begin
   ReadBoolean(Obj,'Forward',El.IsForward,El);
 
@@ -6986,6 +7090,22 @@ begin
     begin
     ReadClassScopeAbstractProcs(Obj,Scope);
     ReadClassScopeInterfaces(Obj,Scope);
+
+    if El.ObjKind in okAllHelpers then
+      begin
+      // restore cached helpers in interface
+      Parent:=El.Parent;
+      while Parent<>nil do
+        begin
+        if Parent.ClassType=TInterfaceSection then
+          begin
+          SectionScope:=Parent.CustomData as TPasSectionScope;
+          Resolver.AddHelper(El,SectionScope.Helpers);
+          break;
+          end;
+        Parent:=Parent.Parent;
+        end;
+      end;
     end;
 end;
 
@@ -7328,8 +7448,9 @@ begin
   ReadElementReference(Obj,Scope,'ImplProc',@Set_ProcedureScope_ImplProc);
   ReadElementReference(Obj,Scope,'Overridden',@Set_ProcedureScope_Overridden);
   if Proc.Parent is TPasMembersType then
-    Scope.ClassOrRecordScope:=Proc.Parent.CustomData as TPasClassOrRecordScope; // no AddRef
-  // ClassScope: TPasClassScope; auto derived
+    Scope.ClassRecScope:=Proc.Parent.CustomData as TPasClassOrRecordScope // no AddRef
+  else
+    ; // set via Set_ProcedureScope_ImplProc
   // Scope.SelfArg only valid for method implementation
 
   Scope.Flags:=ReadProcScopeFlags(Obj,Proc,'SFlags',[]);
@@ -7346,8 +7467,8 @@ var
   DeclProc: TPasProcedure;
 begin
   // Note: the References are stored in the scope object of the declaration proc,
-  //       OTOH in the JSON they are stored in the scope of the implementation
-  //       proc, so that all references can be resolved immediately.
+  //       But TPCUWriter stores them in the implementation scope, so that all
+  //       references can be resolved immediately.
   if ImplScope.ImplProc<>nil then
     RaiseMsg(20180318212631,ImplScope.Element);
   DeclProc:=ImplScope.DeclarationProc;
@@ -7502,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/src/pas2jsfileutils.pp

@@ -40,8 +40,15 @@ function FileIsInPath(const Filename, Path: string): boolean;
 function ChompPathDelim(const Path: string): string;
 function ExpandFileNamePJ(const FileName: string; {const} BaseDir: string = ''): string;
 function ExpandDirectory(const aDirectory: string): string;
-function TryCreateRelativePath(const Filename, BaseDirectory: String;
-  UsePointDirectory: boolean; out RelPath: String): Boolean;
+function IsUNCPath(const Path: String): Boolean;
+function ExtractUNCVolume(const Path: String): String;
+function ExtractFileRoot(FileName: String): String;
+function TryCreateRelativePath(
+  const Dest: String; // Filename
+  const Source: String; // Directory
+  UsePointDirectory: boolean; // True = return '.' for the current directory instead of ''
+  AlwaysRequireSharedBaseFolder: Boolean;// true = only shorten if at least one shared folder
+  out RelPath: String): Boolean;
 function ResolveDots(const AFilename: string): string;
 procedure ForcePathDelims(Var FileName: string);
 function GetForcedPathDelims(Const FileName: string): String;
@@ -201,8 +208,47 @@ begin
   Result:=IncludeTrailingPathDelimiter(Result);
 end;
 
-function TryCreateRelativePath(const Filename, BaseDirectory: String;
-  UsePointDirectory: boolean; out RelPath: String): Boolean;
+{
+  Returns
+  - DriveLetter + : + PathDelim on Windows (if present) or
+  - UNC Share on Windows if present or
+  - PathDelim if FileName starts with PathDelim on Unix or Wince or
+  - Empty string of non eof the above applies
+}
+function ExtractFileRoot(FileName: String): String;
+var
+  Len: Integer;
+begin
+  Result := '';
+  Len := Length(FileName);
+  if (Len > 0) then
+  begin
+    if IsUncPath(FileName) then
+    begin
+      Result := ExtractUNCVolume(FileName);
+      // is it like \\?\C:\Directory?  then also include the "C:\" part
+      if (Result = '\\?\') and (Length(FileName) > 6) and
+         (FileName[5] in ['a'..'z','A'..'Z']) and (FileName[6] = ':') and (FileName[7] in AllowDirectorySeparators)
+      then
+        Result := Copy(FileName, 1, 7);
+    end
+    else
+    begin
+      {$if defined(unix) or defined(wince)}
+      if (FileName[1] = PathDelim) then Result := PathDelim;
+      {$else}
+        {$ifdef HASAMIGA}
+        if Pos(':', FileName) > 1 then
+          Result := Copy(FileName, 1, Pos(':', FileName));
+        {$else}
+        if (Len > 2) and (FileName[1] in ['a'..'z','A'..'Z']) and (FileName[2] = ':') and (FileName[3] in AllowDirectorySeparators) then
+          Result := UpperCase(Copy(FileName,1,3));
+        {$endif}
+      {$endif}
+    end;
+  end;
+end;
+
 {
   Returns True if it is possible to create a relative path from Source to Dest
   Function must be thread safe, so no expanding of filenames is done, since this
@@ -221,104 +267,168 @@ function TryCreateRelativePath(const Filename, BaseDirectory: String;
     no PathDelimiter is appended to the end of RelPath
 
   Examples:
-  - Filename = /foo/bar BaseDirectory = /foo Result = True RelPath = bar
-  - Filename = /foo///bar BaseDirectory = /foo// Result = True RelPath = bar
-  - Filename = /foo BaseDirectory = /foo/bar Result = True RelPath = ../
-  - Filename = /foo/bar BaseDirectory = /bar Result = False (no shared base directory)
-  - Filename = foo/bar BaseDirectory = foo/foo Result = True RelPath = ../bar
-  - Filename = foo/bar BaseDirectory = bar/foo Result = False (no shared base directory)
-  - Filename = /foo BaseDirectory = bar Result = False (mixed absolute and relative)
+  - Dest = /foo/bar Source = /foo Result = True RelPath = bar
+  - Dest = /foo///bar Source = /foo// Result = True RelPath = bar
+  - Dest = /foo Source = /foo/bar Result = True RelPath = ../
+  - Dest = /foo/bar Source = /bar Result = True RelPath = ../foo/bar
+  - Dest = foo/bar Source = foo/foo Result = True RelPath = ../bar
+  - Dest = foo/bar Source = bar/foo Result = False (no shared base directory)
+  - Dest = /foo Source = bar Result = False (mixed absolute and relative)
+  - Dest = c:foo Source = c:bar Result = False (no expanding)
+  - Dest = c:\foo Source = d:\bar Result is False (different drives)
+  - Dest = \foo Source = foo (Windows) Result is False (too ambiguous to guess what this should mean)
+  - Dest = /foo Source = /bar AlwaysRequireSharedBaseFolder = True Result = False
+  - Dest = /foo Source = /bar AlwaysRequireSharedBaseFolder = False Result = True RelPath = ../foo
 }
-  function IsNameChar(c: char): boolean; inline;
+function TryCreateRelativePath(const Dest: String; const Source: String;
+  UsePointDirectory: boolean; AlwaysRequireSharedBaseFolder: Boolean; out
+  RelPath: String): Boolean;
+Type
+  TDirArr =  TStringArray;
+
+  function SplitDirs(Dir: String; out Dirs: TDirArr): integer;
+  var
+    Start, Stop, Len: Integer;
+    S: String;
   begin
-    Result:=(c<>#0) and not (c in AllowDirectorySeparators);
+    Result := 0;
+    Len := Length(Dir);
+    Dirs:=nil;
+    if (Len = 0) then Exit;
+    Start := 1;
+    Stop := 1;
+
+    While Start <= Len do
+    begin
+      if (Dir[Start] in AllowDirectorySeparators) then
+      begin
+        S := Copy(Dir,Stop,Start-Stop);
+        //ignore empty strings, they are caused by double PathDelims, which we just ignore
+        if (S <> '') then
+        begin
+          Inc(Result);
+          if Result>length(Dirs) then
+            SetLength(Dirs,length(Dirs)*2+10);
+          Dirs[Result-1] := S;
+        end;
+        Stop := Start + 1;
+      end;
+      Inc(Start);
+    end;
+
+    S := Copy(Dir,Stop,Start-Stop);
+    if (S <> '') then
+    begin
+      Inc(Result);
+      if Result>length(Dirs) then
+        SetLength(Dirs,length(Dirs)*2+10);
+      Dirs[Result-1] := S;
+    end;
   end;
 
 var
-  UpDirCount: Integer;
-  i: Integer;
-  s: string;
-  SharedDirs: Integer;
-  FileP, BaseP, FileEndP, BaseEndP, FileL, BaseL: integer;
+  SourceRoot, DestRoot, CmpDest, CmpSource: String;
+  CmpDestLen, CmpSourceLen, DestCount, SourceCount, i,
+  SharedFolders, LevelsBack, LevelsUp: Integer;
+  SourceDirs, DestDirs: TDirArr;
+  IsAbs: Boolean;
 begin
-  Result:=false;
-  RelPath:=Filename;
-  if (BaseDirectory='') or (Filename='') then exit;
-  {$IFDEF Windows}
-  // check for different windows file drives
-  if (CompareText(ExtractFileDrive(Filename),
-                     ExtractFileDrive(BaseDirectory))<>0)
-  then
-    exit;
-  {$ENDIF}
+  Result := False;
+  if (Dest = '') or (Source = '') then Exit;
+  if (Pos('..',Dest) > 0) or (Pos('..',Source) > 0) then Exit;
+  SourceRoot := ExtractFileRoot(Source);
+  DestRoot := ExtractFileRoot(Dest);
+  // Root must be same: either both absolute filenames or both relative (and on same drive in Windows)
+  if (CompareFileNames(SourceRoot, DestRoot) <> 0) then Exit;
+  IsAbs := (DestRoot <> '');
+  {$if defined(windows) and not defined(wince)}
+  if not IsAbs then  // relative paths
+  begin
+    //we cannot handle files like c:foo
+    if ((Length(Dest) > 1) and (UpCase(Dest[1]) in ['A'..'Z']) and (Dest[2] = ':')) or
+       ((Length(Source) > 1) and (UpCase(Source[1]) in ['A'..'Z']) and (Source[2] = ':')) then Exit;
+    //we cannot handle combinations like dest=foo source=\bar or the other way around
+    if ((Dest[1] in AllowDirectorySeparators) and not (Source[1] in AllowDirectorySeparators)) or
+       (not (Dest[1] in AllowDirectorySeparators) and (Source[1] in AllowDirectorySeparators)) then Exit;
+  end;
+  {$endif}
 
-  FileP:=1;
-  FileL:=length(Filename);
-  BaseP:=1;
-  BaseL:=length(BaseDirectory);
+  CmpSource := Source;
+  CmpDest := Dest;
 
-  // skip matching directories
-  SharedDirs:=0;
-  if Filename[FileP] in AllowDirectorySeparators then
+  CmpDest := ChompPathDelim(Dest);
+  CmpSource := ChompPathDelim(Source);
+  if IsAbs then
   begin
-    if not (BaseDirectory[BaseP] in AllowDirectorySeparators) then exit;
-    repeat
-      while (FileP<=FileL) and (Filename[FileP] in AllowDirectorySeparators) do
-        inc(FileP);
-      while (BaseP<=BaseL) and (BaseDirectory[BaseP] in AllowDirectorySeparators) do
-        inc(BaseP);
-      if (FileP>FileL) or (BaseP>BaseL) then break;
-      //writeln('TryCreateRelativePath check match .. File="',copy(Filename,FileP),'" Base="',copy(BaseDirectory,BaseP),'"');
-      FileEndP:=FileP;
-      BaseEndP:=BaseP;
-      while (FileEndP<=FileL) and IsNameChar(Filename[FileEndP]) do inc(FileEndP);
-      while (BaseEndP<=BaseL) and IsNameChar(BaseDirectory[BaseEndP]) do inc(BaseEndP);
-      if CompareFilenames(copy(Filename,FileP,FileEndP-FileP),
-        copy(BaseDirectory,BaseP,BaseEndP-BaseP))<>0
-      then
-        break;
-      FileP:=FileEndP;
-      BaseP:=BaseEndP;
-      inc(SharedDirs);
-    until false;
-  end else if (BaseDirectory[BaseP] in AllowDirectorySeparators) then
-    exit;
-
-  //writeln('TryCreateRelativePath skipped matches SharedDirs=',SharedDirs,' File="',copy(Filename,FileP),'" Base="',copy(BaseDirectory,BaseP),'"');
-  if SharedDirs=0 then exit;
-
-  // calculate needed '../'
-  UpDirCount:=0;
-  BaseEndP:=BaseP;
-  while (BaseEndP<=BaseL) and IsNameChar(BaseDirectory[BaseEndP]) do begin
-    inc(UpDirCount);
-    while (BaseEndP<=BaseL) and IsNameChar(BaseDirectory[BaseEndP]) do
-      inc(BaseEndP);
-    while (BaseEndP<=BaseL) and (BaseDirectory[BaseEndP] in AllowDirectorySeparators) do
-      inc(BaseEndP);
+    System.Delete(CmpSource,1,Length(SourceRoot));
+    System.Delete(CmpDest,1,Length(DestRoot));
   end;
 
-  //writeln('TryCreateRelativePath UpDirCount=',UpDirCount,' File="',copy(Filename,FileP),'" Base="',copy(BaseDirectory,BaseP),'"');
-  // create relative filename
-  if (FileP>FileL) and (UpDirCount=0) then
+  //Get rid of excessive trailing PathDelims now after (!) we stripped Root
+  while (Length(CmpDest) > 0) and (CmpDest[Length(CmpDest)] in AllowDirectorySeparators) do System.Delete(CmpDest,Length(CmpDest),1);
+  while (Length(CmpSource) > 0) and (CmpSource[Length(CmpSource)] in AllowDirectorySeparators) do System.Delete(CmpSource,Length(CmpSource),1);
+
+  CmpDestLen := Length(CmpDest);
+  CmpSourceLen := Length(CmpSource);
+
+  DestCount := SplitDirs(CmpDest, DestDirs);
+  SourceCount :=  SplitDirs(CmpSource, SourceDirs);
+
+  //writeln('TryCreaterelativePath: DestDirs:');
+  //for i := 1 to DestCount do writeln(i,' "',DestDirs[i-1],'"');
+  //writeln('TryCreaterelativePath: SrcDirs:');
+  //for i := 1 to SourceCount do writeln(i,' "',SourceDirs[i-1],'"');
+
+  i := 0;
+  SharedFolders := 0;
+  while (i < DestCount) and (i < SourceCount) do
   begin
-    // Filename is the BaseDirectory
-    if UsePointDirectory then
-      RelPath:='.'
+    if CompareFilenames(DestDirs[i], SourceDirs[i]) = 0 then
+    begin
+      Inc(SharedFolders);
+      Inc(i);
+    end
     else
-      RelPath:='';
-    exit(true);
+      Break;
   end;
 
-  s:='';
-  for i:=1 to UpDirCount do
-    s+='..'+PathDelim;
-  if (FileP>FileL) and (UpDirCount>0) then
-    s:=LeftStr(s,length(s)-1)
+  //writeln('TryCreaterelativePath: SharedFolders = ',SharedFolders);
+  if (SharedFolders = 0) and ((not IsAbs) or AlwaysRequireSharedBaseFolder) and not ((CmpDestLen = 0) or (CmpSourceLen = 0)) then
+  begin
+    //debguln('TryCreaterelativePath: FAIL: IsAbs = ',DbgS(IsAs),' AlwaysRequireSharedBaseFolder = ',DbgS(AlwaysRequireSharedBaseFolder),
+    //' SharedFolders = 0, CmpDestLen = ',DbgS(cmpdestlen),' CmpSourceLen = ',DbgS(CmpSourceLen));
+    Exit;
+  end;
+  LevelsBack := SourceCount - SharedFolders;
+  LevelsUp := DestCount - SharedFolders;
+  //writeln('TryCreaterelativePath: LevelsBack = ',Levelsback);
+  //writeln('TryCreaterelativePath: LevelsUp   = ',LevelsUp);
+  if (LevelsBack > 0) then
+  begin
+    RelPath := '';
+    for i := 1 to LevelsBack do RelPath := '..' + PathDelim + Relpath;
+
+    for i := LevelsUp downto 1 do
+    begin
+      if (RelPath <> '') and not (RelPath[Length(RelPath)] in AllowDirectorySeparators) then RelPath := RelPath + PathDelim;
+      RelPath := RelPath + DestDirs[DestCount - i];
+    end;
+    RelPath := ChompPathDelim(RelPath);
+  end
   else
-    s+=copy(Filename,FileP);
-  RelPath:=s;
-  Result:=true;
+  begin
+    RelPath := '';
+    for i := LevelsUp downto 1 do
+    begin
+      if (RelPath <> '') then RelPath := RelPath + PathDelim;
+      RelPath := RelPath + DestDirs[DestCount - i];
+    end;
+  end;
+  if UsePointDirectory and (RelPath = '') then
+    RelPath := '.'; // Dest = Source
+
+  //writeln('TryCreateRelativePath RelPath=',RelPath);
+  Result := True;
 end;
 
 function ResolveDots(const AFilename: string): string;
@@ -542,7 +652,7 @@ begin
 end;
 {$ENDIF}
 
-procedure ForcePathDelims(Var FileName: string);
+procedure ForcePathDelims(var FileName: string);
 begin
   Filename:=GetForcedPathDelims(Filename);
 end;

packages/pastojs/src/pas2jsfileutilsnodejs.inc

@@ -142,6 +142,18 @@ begin
     Result:='';
 end;
 
+function IsUNCPath(const Path: String): Boolean;
+begin
+  Result := false;
+  if Path='' then ;
+end;
+
+function ExtractUNCVolume(const Path: String): String;
+begin
+  Result := '';
+  if Path='' then ;
+end;
+
 function FileIsWritable(const AFilename: string): boolean;
 begin
   try

packages/pastojs/src/pas2jsfileutilsunix.inc

@@ -143,6 +143,18 @@ begin
     Result:='';
 end;
 
+function IsUNCPath(const Path: String): Boolean;
+begin
+  Result := false;
+  if Path='' then ;
+end;
+
+function ExtractUNCVolume(const Path: String): String;
+begin
+  Result := '';
+  if Path='' then ;
+end;
+
 function FileIsWritable(const AFilename: string): boolean;
 begin
   Result := BaseUnix.FpAccess(AFilename, BaseUnix.W_OK) = 0;

packages/pastojs/src/pas2jsfileutilswin.inc

@@ -411,6 +411,56 @@ begin
   Result:=Filename;
 end;
 
+function IsUNCPath(const Path: String): Boolean;
+begin
+  Result := (Length(Path) > 2)
+    and (Path[1] in AllowDirectorySeparators)
+    and (Path[2] in AllowDirectorySeparators);
+end;
+
+function ExtractUNCVolume(const Path: String): String;
+var
+  I, Len: Integer;
+
+  // the next function reuses Len variable
+  function NextPathDelim(const Start: Integer): Integer;// inline;
+  begin
+    Result := Start;
+    while (Result <= Len) and not (Path[Result] in AllowDirectorySeparators) do
+      inc(Result);
+  end;
+
+begin
+  if not IsUNCPath(Path) then
+    Exit('');
+  I := 3;
+  Len := Length(Path);
+  if Path[I] = '?' then
+  begin
+    // Long UNC path form like:
+    // \\?\UNC\ComputerName\SharedFolder\Resource or
+    // \\?\C:\Directory
+    inc(I);
+    if not (Path[I] in AllowDirectorySeparators) then
+      Exit('');
+    if UpperCase(Copy(Path, I + 1, 3)) = 'UNC' then
+    begin
+      inc(I, 4);
+      if I < Len then
+        I := NextPathDelim(I + 1);
+      if I < Len then
+        I := NextPathDelim(I + 1);
+    end;
+  end
+  else
+  begin
+    I := NextPathDelim(I);
+    if I < Len then
+      I := NextPathDelim(I + 1);
+  end;
+  Result := Copy(Path, 1, I);
+end;
+
 function FileGetAttrUTF8(const FileName: String): Longint;
 begin
   Result:=Integer(Windows.GetFileAttributesW(PWideChar(UTF8Decode(FileName))));

packages/pastojs/src/pas2jsfs.pp

@@ -101,7 +101,7 @@ Type
     Function FileExists(Const aFileName: String): Boolean; virtual; abstract;
     function FindUnitJSFileName(const aUnitFilename: string): String; virtual; abstract;
     function FindCustomJSFileName(const aFilename: string): String; virtual; abstract;
-    function FindUnitFileName(const aUnitname, InFilename: string; out IsForeign: boolean): String; virtual; abstract;
+    function FindUnitFileName(const aUnitname, InFilename, ModuleDir: string; out IsForeign: boolean): String; virtual; abstract;
     procedure SaveToFile(ms: TFPJSStream; Filename: string); virtual; abstract;
     function PCUExists(var aFileName: string): Boolean; virtual;
     procedure GetPCUDirs(aList: TStrings; const aBaseDir: String); virtual;

packages/pastojs/src/pas2jsuseanalyzer.pp

@@ -0,0 +1,96 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2019  Mattias Gaertner  [email protected]
+
+    Pascal to Javascript converter class.
+
+    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.
+
+ **********************************************************************
+
+  Abstract:
+    Extends the FCL Pascal use analyzer for the language subset of pas2js.
+}
+unit Pas2jsUseAnalyzer;
+
+{$mode objfpc}{$H+}
+{$inline on}
+
+interface
+
+uses
+  Classes,
+  PasUseAnalyzer, PasTree, PasResolver,
+  FPPas2Js;
+
+type
+
+  { TPas2JSAnalyzer }
+
+  TPas2JSAnalyzer = class(TPasAnalyzer)
+  public
+    procedure UseExpr(El: TPasExpr); override;
+  end;
+
+implementation
+
+{ TPas2JSAnalyzer }
+
+procedure TPas2JSAnalyzer.UseExpr(El: TPasExpr);
+
+  procedure CheckArgs(Args: TFPList);
+  var
+    i: Integer;
+    ArgType: TPasType;
+    ModScope: TPas2JSModuleScope;
+    aMod: TPasModule;
+    SystemVarRecs: TPasFunction;
+  begin
+    if Args=nil then exit;
+    for i:=0 to Args.Count-1 do
+      begin
+      ArgType:=TPasArgument(Args[i]).ArgType;
+      if ArgType=nil then continue;
+      if (ArgType.ClassType=TPasArrayType)
+          and (TPasArrayType(ArgType).ElType=nil) then
+        begin
+        // array of const
+        aMod:=El.GetModule;
+        ModScope:=NoNil(aMod.CustomData) as TPas2JSModuleScope;
+        SystemVarRecs:=ModScope.SystemVarRecs;
+        if SystemVarRecs=nil then
+          RaiseNotSupported(20190216104347,El);
+        MarkImplScopeRef(El,SystemVarRecs,psraRead);
+        UseProcedure(SystemVarRecs);
+        break;
+        end;
+      end;
+  end;
+
+var
+  Ref: TResolvedReference;
+  Decl: TPasElement;
+begin
+  if El=nil then exit;
+  inherited UseExpr(El);
+
+  Ref:=nil;
+  if El.CustomData is TResolvedReference then
+    begin
+    // this is a reference -> mark target
+    Ref:=TResolvedReference(El.CustomData);
+    Decl:=Ref.Declaration;
+    if Decl is TPasProcedure then
+      CheckArgs(TPasProcedure(Decl).ProcType.Args)
+    else if Decl.ClassType=TPasProperty then
+      CheckArgs(Resolver.GetPasPropertyArgs(TPasProperty(Decl)));
+    end;
+end;
+
+end.
+

packages/pastojs/tests/tcfiler.pas

@@ -24,9 +24,10 @@ interface
 
 uses
   Classes, SysUtils, fpcunit, testregistry,
+  jstree,
   PasTree, PScanner, PParser, PasResolveEval, PasResolver, PasUseAnalyzer,
-  FPPas2Js, Pas2JsFiler,
-  tcmodules, jstree;
+  Pas2jsUseAnalyzer, FPPas2Js, Pas2JsFiler,
+  tcmodules;
 
 type
 
@@ -34,11 +35,11 @@ type
 
   TCustomTestPrecompile = Class(TCustomTestModule)
   private
-    FAnalyzer: TPasAnalyzer;
+    FAnalyzer: TPas2JSAnalyzer;
     FInitialFlags: TPCUInitialFlags;
     FPCUReader: TPCUReader;
     FPCUWriter: TPCUWriter;
-    FRestAnalyzer: TPasAnalyzer;
+    FRestAnalyzer: TPas2JSAnalyzer;
     procedure OnFilerGetSrc(Sender: TObject; aFilename: string; out p: PChar;
       out Count: integer);
     function OnConverterIsElementUsed(Sender: TObject; El: TPasElement): boolean;
@@ -120,9 +121,10 @@ 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: TPasAnalyzer read FAnalyzer;
-    property RestAnalyzer: TPasAnalyzer read FRestAnalyzer;
+    property Analyzer: TPas2JSAnalyzer read FAnalyzer;
+    property RestAnalyzer: TPas2JSAnalyzer read FRestAnalyzer;
     property PCUWriter: TPCUWriter read FPCUWriter write FPCUWriter;
     property PCUReader: TPCUReader read FPCUReader write FPCUReader;
     property InitialFlags: TPCUInitialFlags read FInitialFlags;
@@ -155,13 +157,14 @@ type
     procedure TestPC_Proc_Arg;
     procedure TestPC_ProcType;
     procedure TestPC_Proc_Anonymous;
+    procedure TestPC_Proc_ArrayOfConst;
     procedure TestPC_Class;
     procedure TestPC_ClassForward;
     procedure TestPC_ClassConstructor;
     procedure TestPC_Initialization;
     procedure TestPC_BoolSwitches;
     procedure TestPC_ClassInterface;
-    procedure TestPC_IgnoreAttributes;
+    procedure TestPC_Attributes;
 
     procedure TestPC_UseUnit;
     procedure TestPC_UseUnit_Class;
@@ -278,7 +281,7 @@ procedure TCustomTestPrecompile.SetUp;
 begin
   inherited SetUp;
   FInitialFlags:=TPCUInitialFlags.Create;
-  FAnalyzer:=TPasAnalyzer.Create;
+  FAnalyzer:=TPas2JSAnalyzer.Create;
   Analyzer.Resolver:=Engine;
   Analyzer.Options:=Analyzer.Options+[paoImplReferences];
   Converter.OnIsElementUsed:=@OnConverterIsElementUsed;
@@ -378,7 +381,7 @@ begin
     end;
 
     // analyze
-    FRestAnalyzer:=TPasAnalyzer.Create;
+    FRestAnalyzer:=TPas2JSAnalyzer.Create;
     FRestAnalyzer.Resolver:=RestResolver;
     try
       RestAnalyzer.AnalyzeModule(RestResolver.RootElement);
@@ -617,6 +620,8 @@ begin
   CheckRestoredReference(Path+'.AssertMsgConstructor',Orig.AssertMsgConstructor,Rest.AssertMsgConstructor);
   CheckRestoredReference(Path+'.RangeErrorClass',Orig.RangeErrorClass,Rest.RangeErrorClass);
   CheckRestoredReference(Path+'.RangeErrorConstructor',Orig.RangeErrorConstructor,Rest.RangeErrorConstructor);
+  CheckRestoredReference(Path+'.SystemTVarRec',Orig.SystemTVarRec,Rest.SystemTVarRec);
+  CheckRestoredReference(Path+'.SystemVarRecs',Orig.SystemVarRecs,Rest.SystemVarRecs);
   CheckRestoredPasScope(Path,Orig,Rest);
 end;
 
@@ -668,6 +673,7 @@ procedure TCustomTestPrecompile.CheckRestoredSectionScope(const Path: string;
 var
   i: Integer;
   OrigUses, RestUses: TPas2JSSectionScope;
+  OrigHelperEntry, RestHelperEntry: TPRHelperEntry;
 begin
   if Orig.BoolSwitches<>Rest.BoolSwitches then
     Fail(Path+'.BoolSwitches Orig='+BoolSwitchesToStr(Orig.BoolSwitches)+' Rest='+BoolSwitchesToStr(Rest.BoolSwitches));
@@ -684,6 +690,18 @@ begin
       Fail(Path+'.UsesScopes['+IntToStr(i)+'] Orig='+GetObjName(OrigUses)+' Rest='+GetObjName(RestUses));
     CheckRestoredReference(Path+'.UsesScopes['+IntToStr(i)+']',OrigUses.Element,RestUses.Element);
     end;
+  AssertEquals(Path+' length(Helpers)',length(Orig.Helpers),length(Rest.Helpers));
+  for i:=0 to length(Orig.Helpers)-1 do
+    begin
+    OrigHelperEntry:=TPRHelperEntry(Orig.Helpers[i]);
+    RestHelperEntry:=TPRHelperEntry(Rest.Helpers[i]);
+    if OrigHelperEntry.ClassType<>RestHelperEntry.ClassType then
+      Fail(Path+'.Helpers['+IntToStr(i)+'] Orig='+GetObjName(OrigHelperEntry)+' Rest='+GetObjName(RestHelperEntry));
+    AssertEquals(Path+'.Helpers['+IntToStr(i)+'].Added',OrigHelperEntry.Added,RestHelperEntry.Added);
+    CheckRestoredReference(Path+'.Helpers['+IntToStr(i)+'].Helper',OrigHelperEntry.Helper,RestHelperEntry.Helper);
+    CheckRestoredReference(Path+'.Helpers['+IntToStr(i)+'].HelperForType',OrigHelperEntry.HelperForType,RestHelperEntry.HelperForType);
+    end;
+
   AssertEquals(Path+'.Finished',Orig.Finished,Rest.Finished);
   CheckRestoredIdentifierScope(Path,Orig,Rest);
 end;
@@ -810,7 +828,7 @@ begin
     AssertEquals(Path+'.ResultVarName',Orig.ResultVarName,Rest.ResultVarName);
     CheckRestoredReference(Path+'.OverriddenProc',Orig.OverriddenProc,Rest.OverriddenProc);
 
-    CheckRestoredScopeReference(Path+'.ClassScope',Orig.ClassOrRecordScope,Rest.ClassOrRecordScope);
+    CheckRestoredScopeReference(Path+'.ClassScope',Orig.ClassRecScope,Rest.ClassRecScope);
     CheckRestoredElement(Path+'.SelfArg',Orig.SelfArg,Rest.SelfArg);
     if Orig.Flags<>Rest.Flags then
       Fail(Path+'.Flags');
@@ -1164,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);
 
@@ -1553,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;
@@ -2008,6 +2034,23 @@ begin
   WriteReadUnit;
 end;
 
+procedure TTestPrecompile.TestPC_Proc_ArrayOfConst;
+begin
+  StartUnit(true,[supTVarRec]);
+  Add([
+  'interface',
+  'procedure Fly(arr: array of const);',
+  'implementation',
+  'procedure Fly(arr: array of const);',
+  'begin',
+  '  if arr[1].VType=1 then ;',
+  '  if arr[2].VInteger=1 then ;',
+  '  Fly([true,0.3]);',
+  'end;',
+  '']);
+  WriteReadUnit;
+end;
+
 procedure TTestPrecompile.TestPC_Class;
 begin
   StartUnit(false);
@@ -2179,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/tcoptimizations.pas

@@ -25,7 +25,7 @@ interface
 
 uses
   Classes, SysUtils, testregistry, fppas2js, pastree,
-  PScanner, PasUseAnalyzer, PasResolver, PasResolveEval,
+  PScanner, Pas2jsUseAnalyzer, PasResolver, PasResolveEval,
   tcmodules;
 
 type
@@ -34,8 +34,8 @@ type
 
   TCustomTestOptimizations = class(TCustomTestModule)
   private
-    FAnalyzerModule: TPasAnalyzer;
-    FAnalyzerProgram: TPasAnalyzer;
+    FAnalyzerModule: TPas2JSAnalyzer;
+    FAnalyzerProgram: TPas2JSAnalyzer;
     FWholeProgramOptimization: boolean;
     function OnConverterIsElementUsed(Sender: TObject; El: TPasElement): boolean;
     function OnConverterIsTypeInfoUsed(Sender: TObject; El: TPasElement): boolean;
@@ -46,8 +46,8 @@ type
     procedure ParseProgram; override;
     function CreateConverter: TPasToJSConverter; override;
   public
-    property AnalyzerModule: TPasAnalyzer read FAnalyzerModule;
-    property AnalyzerProgram: TPasAnalyzer read FAnalyzerProgram;
+    property AnalyzerModule: TPas2JSAnalyzer read FAnalyzerModule;
+    property AnalyzerProgram: TPas2JSAnalyzer read FAnalyzerProgram;
     property WholeProgramOptimization: boolean read FWholeProgramOptimization
         write FWholeProgramOptimization;
   end;
@@ -78,6 +78,8 @@ type
     procedure TestWPO_Class_OmitPropertySetter2;
     procedure TestWPO_CallInherited;
     procedure TestWPO_UseUnit;
+    procedure TestWPO_ArrayOfConst_Use;
+    procedure TestWPO_ArrayOfConst_NotUsed;
     procedure TestWPO_Class_PropertyInOtherUnit;
     procedure TestWPO_ProgramPublicDeclaration;
     procedure TestWPO_ConstructorDefaultValueConst;
@@ -92,7 +94,7 @@ implementation
 function TCustomTestOptimizations.OnConverterIsElementUsed(Sender: TObject;
   El: TPasElement): boolean;
 var
-  A: TPasAnalyzer;
+  A: TPas2JSAnalyzer;
 begin
   if WholeProgramOptimization then
     A:=AnalyzerProgram
@@ -114,7 +116,7 @@ end;
 function TCustomTestOptimizations.OnConverterIsTypeInfoUsed(Sender: TObject;
   El: TPasElement): boolean;
 var
-  A: TPasAnalyzer;
+  A: TPas2JSAnalyzer;
 begin
   if WholeProgramOptimization then
     A:=AnalyzerProgram
@@ -137,9 +139,9 @@ procedure TCustomTestOptimizations.SetUp;
 begin
   inherited SetUp;
   FWholeProgramOptimization:=false;
-  FAnalyzerModule:=TPasAnalyzer.Create;
+  FAnalyzerModule:=TPas2JSAnalyzer.Create;
   FAnalyzerModule.Resolver:=Engine;
-  FAnalyzerProgram:=TPasAnalyzer.Create;
+  FAnalyzerProgram:=TPas2JSAnalyzer.Create;
   FAnalyzerProgram.Resolver:=Engine;
 end;
 
@@ -763,7 +765,7 @@ begin
     '});',
     ' rtl.createClass($mod, "TMobile", $mod.TObject, function () {',
     '  this.DoA$1 = function () {',
-    '    $mod.TObject.DoA.apply(this, arguments);',
+    '    $mod.TObject.DoA.call(this);',
     '  };',
     '  this.DoC = function () {',
     '    $mod.TObject.DoB.call(this);',
@@ -814,6 +816,60 @@ begin
   CheckDiff('TestWPO_UseUnit',ExpectedSrc,ActualSrc);
 end;
 
+procedure TTestOptimizations.TestWPO_ArrayOfConst_Use;
+begin
+  StartProgram(true,[supTVarRec]);
+  Add([
+  'procedure Say(arr: array of const);',
+  'begin',
+  'end;',
+  'begin',
+  '  Say([true]);']);
+  ConvertProgram;
+  CheckUnit('system.pp',
+  LinesToStr([
+  'rtl.module("system", [], function () {',
+  '  var $mod = this;',
+  '  rtl.recNewT($mod, "TVarRec", function () {',
+  '    this.VType = 0;',
+  '    this.VJSValue = undefined;',
+  '    this.$eq = function (b) {',
+  '      return (this.VType === b.VType) && (this.VJSValue === b.VJSValue);',
+  '    };',
+  '    this.$assign = function (s) {',
+  '      this.VType = s.VType;',
+  '      this.VJSValue = s.VJSValue;',
+  '      return this;',
+  '    };',
+  '  });',
+  '  this.VarRecs = function () {',
+  '    var Result = [];',
+  '    var v = null;',
+  '    v.VType = 1;',
+  '    v.VJSValue = 2;',
+  '    return Result;',
+  '  };',
+  '});',
+  '']));
+end;
+
+procedure TTestOptimizations.TestWPO_ArrayOfConst_NotUsed;
+begin
+  StartProgram(true,[supTVarRec]);
+  Add([
+  'procedure Say(arr: array of const);',
+  'begin',
+  'end;',
+  'begin']);
+  ConvertProgram;
+  CheckUnit('system.pp',
+  LinesToStr([
+  'rtl.module("system", [], function () {',
+  '  var $mod = this;',
+  '});',
+  '']));
+end;
+
 procedure TTestOptimizations.TestWPO_Class_PropertyInOtherUnit;
 begin
   AddModuleWithIntfImplSrc('unit1.pp',

packages/pastojs/tests/tcprecompile.pas

@@ -59,8 +59,9 @@ type
     procedure TestPCU_Overloads;
     procedure TestPCU_Overloads_MDelphi_ModeObjFPC;
     procedure TestPCU_UnitCycle;
-    procedure TestPCU_ClassForward;
-    procedure TestPCU_ClassConstructor;
+    procedure TestPCU_Class_Forward;
+    procedure TestPCU_Class_Constructor;
+    procedure TestPCU_Class_ClassConstructor;
     procedure TestPCU_ClassInterface;
     procedure TestPCU_Namespace;
     procedure TestPCU_CheckVersionMain;
@@ -300,7 +301,7 @@ begin
   CheckPrecompile('test1.pas','src');
 end;
 
-procedure TTestCLI_Precompile.TestPCU_ClassForward;
+procedure TTestCLI_Precompile.TestPCU_Class_Forward;
 begin
   AddUnit('src/system.pp',[
     'type integer = longint;',
@@ -339,7 +340,7 @@ begin
   CheckPrecompile('test1.pas','src');
 end;
 
-procedure TTestCLI_Precompile.TestPCU_ClassConstructor;
+procedure TTestCLI_Precompile.TestPCU_Class_Constructor;
 begin
   AddUnit('src/system.pp',[
     'type integer = longint;',
@@ -379,6 +380,41 @@ begin
   CheckPrecompile('test1.pas','src');
 end;
 
+procedure TTestCLI_Precompile.TestPCU_Class_ClassConstructor;
+begin
+  AddUnit('src/system.pp',[
+    'type integer = longint;',
+    'procedure Writeln; varargs;'],
+    ['procedure Writeln; begin end;']);
+  AddUnit('src/unit1.pp',[
+    'type',
+    '  TObject = class',
+    '    constructor Create;',
+    '  end;',
+    '  TBird = class',
+    '    class constructor Init;',
+    '  end;',
+    ''],[
+    'constructor TObject.Create; begin end;',
+    'class constructor TBird.Init; begin end;',
+    '']);
+  AddUnit('src/unit2.pp',[
+    'uses unit1;',
+    'procedure DoIt;',
+    ''],[
+    'procedure DoIt;',
+    'begin',
+    '  TBird.Create;',
+    'end;',
+    '']);
+  AddFile('test1.pas',[
+    'uses unit2;',
+    'begin',
+    '  DoIt;',
+    'end.']);
+  CheckPrecompile('test1.pas','src');
+end;
+
 procedure TTestCLI_Precompile.TestPCU_ClassInterface;
 begin
   AddUnit('src/system.pp',[
@@ -536,7 +572,7 @@ end;
 procedure TTestCLI_Precompile.TestPCU_CheckVersionSystem;
 var
   aFile: TCLIFile;
-  s, JSFilename, ExpectedSrc: string;
+  s, JSFilename, ExpectedSrc, VerStr: string;
 begin
   AddUnit('src/system.pp',[
     'type integer = longint;'],
@@ -549,10 +585,11 @@ begin
   aFile:=FindFile(JSFilename);
   AssertNotNull('File not found '+JSFilename,aFile);
   writeln('TTestCLI_Precompile.TestPCU_CheckVersionMain ',aFile.Source);
+  VerStr:=IntToStr((VersionMajor*100+VersionMinor)*100+VersionRelease);
   ExpectedSrc:=LinesToStr([
     UTF8BOM+'rtl.module("system",[],function () {',
     '  "use strict";',
-    '  rtl.checkVersion(10301);',
+    '  rtl.checkVersion('+VerStr+');',
     '  var $mod = this;',
     '});']);
   if not CheckSrcDiff(ExpectedSrc,aFile.Source,s) then

packages/pastojs/tests/tcunitsearch.pas

@@ -135,6 +135,8 @@ type
 
   TTestCLI_UnitSearch = class(TCustomTestCLI)
   published
+    procedure TestUS_CreateRelativePath;
+
     procedure TestUS_Program;
     procedure TestUS_UsesEmptyFileFail;
     procedure TestUS_Program_o;
@@ -145,6 +147,7 @@ type
     procedure TestUS_UsesInFile;
     procedure TestUS_UsesInFile_Duplicate;
     procedure TestUS_UsesInFile_IndirectDuplicate;
+    procedure TestUS_UsesInFile_WorkNotEqProgDir;
   end;
 
 function LinesToStr(const Lines: array of string): string;
@@ -584,6 +587,49 @@ end;
 
 { TTestCLI_UnitSearch }
 
+procedure TTestCLI_UnitSearch.TestUS_CreateRelativePath;
+
+  procedure DoTest(Filename, BaseDirectory, Expected: string;
+    UsePointDirectory: boolean = false);
+  var
+    Actual: String;
+  begin
+    ForcePathDelims(Filename);
+    ForcePathDelims(BaseDirectory);
+    ForcePathDelims(Expected);
+    if not TryCreateRelativePath(Filename,BaseDirectory,UsePointDirectory,true,Actual) then
+      Actual:=Filename;
+    AssertEquals('TryCreateRelativePath(File='+Filename+',Base='+BaseDirectory+')',
+      Expected,Actual);
+  end;
+
+begin
+  DoTest('/a','/a','');
+  DoTest('/a','/a','.',true);
+  DoTest('/a','/a/','');
+  DoTest('/a/b','/a/b','');
+  DoTest('/a/b','/a/b/','');
+  DoTest('/a','/a/','');
+  DoTest('/a','','/a');
+  DoTest('/a/b','/a','b');
+  DoTest('/a/b','/a/','b');
+  DoTest('/a/b','/a//','b');
+  DoTest('/a','/a/b','..');
+  DoTest('/a','/a/b/','..');
+  DoTest('/a','/a/b//','..');
+  DoTest('/a/','/a/b','..');
+  DoTest('/a','/a/b/c','../..');
+  DoTest('/a','/a/b//c','../..');
+  DoTest('/a','/a//b/c','../..');
+  DoTest('/a','/a//b/c/','../..');
+  DoTest('/a','/b','/a');
+  DoTest('~/bin','/','~/bin');
+  DoTest('$(HOME)/bin','/','$(HOME)/bin');
+  {$IFDEF MSWindows}
+  DoTest('D:\a\b\c.pas','D:\a\d\','..\b\c.pas');
+  {$ENDIF}
+end;
+
 procedure TTestCLI_UnitSearch.TestUS_Program;
 begin
   AddUnit('system.pp',[''],['']);
@@ -707,6 +753,22 @@ begin
   AssertEquals('ErrorMsg','Duplicate file found: "'+WorkDir+'unit1.pas" and "'+WorkDir+'sub/unit1.pas"',ErrorMsg);
 end;
 
+procedure TTestCLI_UnitSearch.TestUS_UsesInFile_WorkNotEqProgDir;
+begin
+  AddUnit('system.pp',[''],['']);
+  AddUnit('sub/unit2.pas',
+  ['var a: longint;'],
+  ['']);
+  AddUnit('sub/unit1.pas',
+  ['uses unit2;'],
+  ['']);
+  AddFile('sub/test1.pas',[
+    'uses foo in ''unit1.pas'';',
+    'begin',
+    'end.']);
+  Compile(['sub/test1.pas','-Jc']);
+end;
+
 Initialization
   RegisterTests([TTestCLI_UnitSearch]);
 end.

packages/pastojs/tests/testpas2js.lpi

@@ -32,7 +32,7 @@
         <PackageName Value="FCL"/>
       </Item2>
     </RequiredPackages>
-    <Units Count="11">
+    <Units Count="12">
       <Unit0>
         <Filename Value="testpas2js.pp"/>
         <IsPartOfProject Value="True"/>
@@ -83,6 +83,11 @@
         <IsPartOfProject Value="True"/>
         <UnitName Value="TCPrecompile"/>
       </Unit10>
+      <Unit11>
+        <Filename Value="../src/pas2jsuseanalyzer.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="Pas2jsUseAnalyzer"/>
+      </Unit11>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

packages/pastojs/tests/testpas2js.pp

@@ -21,7 +21,7 @@ uses
   MemCheck,
   {$ENDIF}
   Classes, consoletestrunner, tcconverter, tcmodules, tcoptimizations, tcsrcmap,
-  tcfiler, Pas2JsFiler, tcunitsearch, tcprecompile;
+  tcfiler, Pas2JsFiler, tcunitsearch, tcprecompile, pas2jsuseanalyzer;
 
 type
 

utils/fpdoc/dw_html.pp

@@ -3369,10 +3369,10 @@ var
     TDEl := CreateTD(TREl);
     CodeEl := CreateCode(CreatePara(TDEl));
     AppendKw(CodeEl, 'type');
-    if AClass.ObjKind=okGeneric then
+    if AClass.GenericTemplateTypes.Count>0 then
       AppendKw(CodeEl, ' generic ');
     AppendText(CodeEl, ' ' + AClass.Name + ' ');
-    if AClass.ObjKind=okGeneric then
+    if AClass.GenericTemplateTypes.Count>0 then
       AppendGenericTypes(CodeEl,AClass.GenericTemplateTypes,false);
     AppendSym(CodeEl, '=');
     AppendText(CodeEl, ' ');

utils/pas2js/compileserver.lpi

@@ -48,6 +48,7 @@
     </Target>
     <SearchPaths>
       <IncludeFiles Value="$(ProjOutDir)"/>
+      <OtherUnitFiles Value="../../packages/fcl-js/src;../../packages/fcl-json/src;../../packages/fcl-passrc/src;../../packages/pastojs/src"/>
       <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
     </SearchPaths>
   </CompilerOptions>

utils/pas2js/dist/rtl.js

@@ -2,7 +2,7 @@
 
 var rtl = {
 
-  version: 10301,
+  version: 10501,
 
   quiet: false,
   debug_load_units: false,
@@ -279,12 +279,16 @@ var rtl = {
       // if root is a "function" then c.$ancestor === c.__proto__, Object.getPrototypeOf(c) returns the root
     } else {
       c = {};
-      c.$create = function(fnname,args){
+      c.$create = function(fn,args){
         if (args == undefined) args = [];
         var o = Object.create(this);
         o.$init();
         try{
-          o[fnname].apply(o,args);
+          if (typeof(fn)==="string"){
+            o[fn].apply(o,args);
+          } else {
+            fn.apply(o,args);
+          };
           o.AfterConstruction();
         } catch($e){
           // do not call BeforeDestruction
@@ -308,17 +312,21 @@ var rtl = {
     // If newinstancefnname is given, use that function to create the new object.
     // If exist call BeforeDestruction and AfterConstruction.
     var c = Object.create(ancestor);
-    c.$create = function(fnname,args){
+    c.$create = function(fn,args){
       if (args == undefined) args = [];
       var o = null;
       if (newinstancefnname.length>0){
-        o = this[newinstancefnname](fnname,args);
+        o = this[newinstancefnname](fn,args);
       } else {
         o = Object.create(this);
       }
       if (o.$init) o.$init();
       try{
-        o[fnname].apply(o,args);
+        if (typeof(fn)==="string"){
+          o[fn].apply(o,args);
+        } else {
+          fn.apply(o,args);
+        };
         if (o.AfterConstruction) o.AfterConstruction();
       } catch($e){
         // do not call BeforeDestruction
@@ -336,21 +344,47 @@ var rtl = {
     rtl.initClass(c,parent,name,initfn);
   },
 
+  createHelper: function(parent,name,ancestor,initfn){
+    // create a helper,
+    // ancestor must be null or a helper,
+    var c = null;
+    if (ancestor != null){
+      c = Object.create(ancestor);
+      c.$ancestor = ancestor;
+      // c.$ancestor === Object.getPrototypeOf(c)
+    } else {
+      c = {};
+    };
+    parent[name] = c;
+    c.$class = c; // Note: o.$class === Object.getPrototypeOf(o)
+    c.$classname = name;
+    parent = rtl.initStruct(c,parent,name);
+    c.$fullname = parent.$name+'.'+name;
+    // rtti
+    var t = c.$module.$rtti.$Helper(c.$name,{ "helper": c });
+    c.$rtti = t;
+    if (rtl.isObject(ancestor)) t.ancestor = ancestor.$rtti;
+    if (!t.ancestor) t.ancestor = null;
+    // init members
+    initfn.call(c);
+  },
+
   tObjectDestroy: "Destroy",
 
   free: function(obj,name){
-    if (obj[name]==null) return;
+    if (obj[name]==null) return null;
     obj[name].$destroy(rtl.tObjectDestroy);
     obj[name]=null;
   },
 
   freeLoc: function(obj){
-    if (obj==null) return;
+    if (obj==null) return null;
     obj.$destroy(rtl.tObjectDestroy);
     return null;
   },
 
   recNewT: function(parent,name,initfn,full){
+    // create new record type
     var t = {};
     if (parent) parent[name] = t;
     function hide(prop){
@@ -408,6 +442,8 @@ var rtl = {
   EInvalidCast: null,
   EAbstractError: null,
   ERangeError: null,
+  EIntOverflow: null,
+  EPropWriteOnly: null,
 
   raiseE: function(typename){
     var t = rtl[typename];
@@ -693,6 +729,12 @@ var rtl = {
     rtl.raiseE("EInvalidCast");
   },
 
+  oc: function(i){
+    // overflow check integer
+    if ((Math.floor(i)===i) && (i>=-0x1fffffffffffff) && (i<=0x1fffffffffffff)) return i;
+    rtl.raiseE('EIntOverflow');
+  },
+
   rc: function(i,minval,maxval){
     // range check integer
     if ((Math.floor(i)===i) && (i>=minval) && (i<=maxval)) return i;
@@ -1155,7 +1197,8 @@ var rtl = {
     newBaseTI("tTypeInfoRecord",12 /* tkRecord */,rtl.tTypeInfoStruct);
     newBaseTI("tTypeInfoClass",13 /* tkClass */,rtl.tTypeInfoStruct);
     newBaseTI("tTypeInfoClassRef",14 /* tkClassRef */);
-    newBaseTI("tTypeInfoInterface",15 /* tkInterface */,rtl.tTypeInfoStruct);
+    newBaseTI("tTypeInfoInterface",18 /* tkInterface */,rtl.tTypeInfoStruct);
+    newBaseTI("tTypeInfoHelper",19 /* tkHelper */,rtl.tTypeInfoStruct);
   },
 
   tSectionRTTI: {
@@ -1205,7 +1248,8 @@ var rtl = {
     $Class: function(name,o){ return this.$Scope(name,rtl.tTypeInfoClass,o); },
     $ClassRef: function(name,o){ return this.$inherited(name,rtl.tTypeInfoClassRef,o); },
     $Pointer: function(name,o){ return this.$inherited(name,rtl.tTypeInfoPointer,o); },
-    $Interface: function(name,o){ return this.$Scope(name,rtl.tTypeInfoInterface,o); }
+    $Interface: function(name,o){ return this.$Scope(name,rtl.tTypeInfoInterface,o); },
+    $Helper: function(name,o){ return this.$Scope(name,rtl.tTypeInfoHelper,o); }
   },
 
   newTIParam: function(param){

utils/pas2js/docs/translation.html

@@ -57,6 +57,7 @@
     <a href="#classof">Translating class-of type</a><br>
     <a href="#tobjectfree">Translating TObject.Free</a><br>
     <a href="#classinterfaces">Translating class interfaces</a><br>
+    <a href="#helpers">Translating helpers</a><br>
     <a href="#attributes">Translating attributes</a><br>
     <a href="#tryfinally">Translating try..finally</a><br>
     <a href="#tryexcept">Translating try..except</a><br>
@@ -158,8 +159,9 @@ Put + after a boolean switch option to enable it, - to disable it
    -Jl    : lower case identifiers
    -Jm    : generate source maps
      -Jmsourceroot=&lt;x&gt; : use x as "sourceRoot", prefix URL for source file names.
-     -Jmbasedir=&lt;x&gt; : write source file names relative to directory x.
+     -Jmbasedir=&lt;x&gt; : write source file names relative to directory x, default is map file folder.
      -Jminclude : include Pascal sources in source map.
+     -Jmabsolute: store absolute filenames, not relative.
      -Jmxssiheader : start source map with XSSI protection )]}.
      -Jm- : disable generating source maps
    -Jo&lt;x&gt; : Enable or disable extra option. The x is case insensitive:
@@ -513,7 +515,7 @@ function(){
     <li><b>Integers overflows</b> at runtime differ from Delphi/FPC, due to the double format.
       For example adding <i>var i: byte = 200; ... i:=i+100;</i> will result in
       <i>i=300</i> instead of <i>i=44</i> as in Delphi/FPC.
-      When range checking <i>{$R+}</i> is enabled <i>i=300</i> will raise an ERangeError.</li>
+      When range checking <i>{$R+}</i> is enabled <i>i:=300</i> will raise an ERangeError.</li>
     <li><b>type cast integer to integer</b>, e.g. <i>byte(aLongInt)</i>
       <ul>
         <li>with range checking enabled: error if outside range</li>
@@ -593,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>
@@ -728,12 +730,12 @@ function(){
           <li>property, class property, array property, default array property</li>
           <li>sub types</li>
           <li>constructor</li>
+          <li>class constructor</li>
         </ul>
       </li>
       <li>Not yet implemented:
         <ul>
           <li>operator overloading</li>
-          <li>class constructor</li>
           <li>reference counted interfaces as fields</li>
           <li>Interfaces as nested types</li>
           <li>default non array property</li>
@@ -1516,7 +1518,15 @@ function(){
     <li>In Delphi/FPC an empty array is <i>nil</i>. In JS it can be <i>null</i> or <i>[]</i>.
      For compatibility comparing an array with <i>nil</i> checks for <i>length(a)>0</i>.</li>
     <li><i>function Assigned(array): boolean</i>  results true iff <i>length(array)>0</i>.</li>
-    <li>Not yet implemented: array of const.</li>
+    <li>array of const:
+      <ul>
+      <li>Works the same: vtInteger, vtBoolean, vtPointer, vtObject, vtClass, vtWideChar, vtInterface, vtUnicodeString</li>
+      <li>''longword'' is converted to ''vtNativeInt''. Delphi/FPC converts to ''vtInteger'', changing big numbers to negative numbers.</li>
+      <li>vtExtended is double, Delphi/FPC: PExtended</li>
+      <li>vtCurrency is currency, Delphi/FPC: PCurrency</li>
+      <li>Not supported: vtChar, vtString, vtPChar, vtPWideChar, vtAnsiString, vtVariant, vtWideString, vtInt64, vtQWord</li>
+      <li>only in pas2js: vtNativeInt, vtJSValue</li>
+      </ul></li>
     <li>Assignation using constant array, e.g. <i>a:=[1,1,2];</i></li>
     <li>String like operation: + operator concatenates arrays. e.g. <i>a:=[1]+[2];</i>.
       This is controlled by modeswitch arrayoperators, which is enabled in mode delphi.</li>
@@ -1596,11 +1606,20 @@ 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, external methods,
-      virtual, override, abstract, call inherited, assigned(), type cast,
-      overloads, reintroduce, sealed class, nested types.</li>
-    <li>Not supported: class constructor/destructor</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>
       <li>References are replaced by getter/setter.</li>
@@ -1608,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
@@ -1830,10 +1849,85 @@ function(){
     Not yet supported: array of intferfacetype, interface as record member.
     </div>
 
+    <div class="section">
+    <h2 id="helpers">Translating helpers</h2>
+    Pas2js supports class helpers, record helpers and type helpers since 1.3.
+    The extend is only virtual, the helped type is kept untouched.
+    <br>
+    <ul>
+      <li>A <b>class helper</b> can "extend" Pascal classes and external JS classes.</li>
+      <li>A <b>record helper</b> can "extend" a record type. In $mode delphi a
+        record helper can extend other types as well, see <i>type helper</i></li>
+      <li>A <b>type helper</b> can extend all base types like integer, string,
+        char, boolean, double, currency, and some user types like enumeration,
+        set, range and array types. It cannot extend interfaces or helpers.<br>
+        Type helpers are enabled by default in <i>$mode delphi</i> and disabled in <i>$mode objfpc</i>.
+        You can enable them with <b>{$modeswitch typehelpers}</b>.
+        </li>
+      <li>By default only one helper is active per type, same as in FPC/Delphi.
+        If there are multiple helpers for the same type, the last helper in scope wins.<br>
+        A class with ancestors can have one active helper per ancestor type, so
+        multiple helpers can be active, same as FPC/Delphi.<br>
+        Using <b>{$modeswitch multiplescopehelpers}</b> you can activate all helpers
+        within scope.
+        </li>
+      <li>Nested helpers (e.g. <i>TDemo.TSub.THelper</i>) are elevated.
+        Visibility is ignored. Same as FPC/Delphi.</li>
+      <li>Helpers cannot be forward defined (e.g. no <i>THelper = helper;</i>).</li>
+      <li>Helpers must not have fields.</li>
+      <li><b>Class Var, Const, Type</b></li>
+      <li><b>Visibility</b> : <i>strict private .. published</i></li>
+      <li><b>Function, procedure</b>:
+        In class and record helpers <i>Self</i> is the class/record instance. For other
+        types Self is a reference to the passed value.
+      </li>
+      <li><b>Class function, class procedure</b>: Helpers for Pascal classes/records can
+        add <i>static</i> and non static class functions. Helpers for external classes
+        and other types can only add static class functions.</li>
+      <li><b>Constructor</b>. Not for external classes. Works similar to
+        construcors, i.e. <i>THelpedClass.Create</i> creates a new instance, while
+        <i>AnObj.Create</i> calls the constructor function as normal method. Note that
+        Delphi does not allow calling helper construcors as normal method.</li>
+      <li>no destructor</li>
+      <li><b>Property</b> : getters/setters can refer to members of the helper, its
+        ancestors and the helped class/record.</li>
+      <li><b>Class property</b> : getter can be static or non static. Delphi/FPC only allows static.</li>
+      <li><b>Ancestors</b> : Helpers can have an ancestor helper, but they
+      do not have a shared root class, especially not <i>TObject</i>.</li>
+      <li><b>no virtual, abstract, override</b>. Delphi allows them, but 10.3 crashes when calling.</li>
+      <li><b>inherited</b> :
+        <i>inherited</i> inside a method of a class/record calls helper of ancestor.<br>
+        <i>inherited</i> inside a helper depends on the $mode:
+        <ul>
+        <li> <i>$mode objfpc</i> : <i>inherited;</i> and <i>inherited Name(args);</i>
+          work the same and searches first in HelperForType, then in ancestor(s).</li>
+        <li><i>$mode delphi: inherited;</i> : skip ancestors and HelperForType,
+          searches first in helper(s) of ancestor of HelperForType.</li>
+        <li><i>$mode delphi: inherited name(args);</i> :
+          same as $mode objfpc first searches in HelperForType, then Ancestor(s)</li>
+        </ul>
+        In any case if <i>inherited;</i> has no ancestor to call, it is silently ignored,
+        while <i>inherited Name;</i> gives an error.
+        </li>
+      <li><b>RTTI</b>: <i>typeinfo(somehelper)</i> returns a pointer to <i>TTypeInfoHelper</i> with <i>Kind tkHelper</i>.</li>
+      <li>There are some special cases when using a <b>type helper</b> function/procedure on a value:
+        <ul>
+        <li><i>function result</i> : using a temporary variable</li>
+        <li><i>const, const argument</i> : When helper function tries to assign a value,
+        pas2js raises a EPropReadOnly exception. FPC/Delphi use a temporary variable allowing the write. </li>
+        <li><i>property</i> : uses only the getter, ignoring the setter.
+          This breaks OOP, as it allows to change fields without calling the setter.
+          This is FPC/Delphi compatible.</li>
+        <li><i>with value do ;</i> : uses a temporary variable. Delphi/FPC do not support it.</li>
+        </ul>
+      </li>
+    </ul>
+    </div>
+
     <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">
@@ -2949,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>
@@ -2993,22 +3087,20 @@ End.
     <li>Intrinsic procedure WriteStr(out s: string; params...)</li>
     <li><i>Debugger;</i> converts to <i>debugger;</i>. If a debugger is running
       it will break on this line just like a break point.</li>
-    <li><i>concat(string1,string2,...)</i> since 1.3</li>
+    <li><i>function concat(string1,string2,...): string</i> since 1.3</li>
+    <li><i>$mode delphi: function lo|hi(integer): byte</i> since 1.3</li>
+    <li><i>$mode objfpc: function lo|hi(integer): byte|word|longword</i> since 1.3</li>
     </ul>
     </div>
 
     <div class="section">
     <h2 id="notsupportedelements">Not supported elements</h2>
     <ul>
-    <li>Advanced records</li>
-    <li>Anonymous functions</li>
-    <li>Array of const</li>
-    <li>Attributes</li>
+    <li>Class destructor</li>
     <li>Enums with custom values</li>
     <li>Generics</li>
     <li>Global properties</li>
     <li>Futures</li>
-    <li>Helpers for types, classes, records</li>
     <li>Inline</li>
     <li>Library</li>
     <li>Objects</li>
@@ -3017,7 +3109,6 @@ End.
     <li>Package</li>
     <li>Resources</li>
     <li>RTTI extended, $RTTI</li>
-    <li>Runtime checks: Overflow -Co, $Q</li>
     <li>Variant records</li>
     <li>Variants</li>
     </ul>

utils/pas2js/fpmake.pp

@@ -26,8 +26,6 @@ begin
     P.Directory:=ADirectory;
     P.Version:='3.2.0-beta';
     P.OSes:=AllUnixOSes+AllBSDOSes+AllWindowsOSes-[WinCE];
-    if Defaults.CPU=jvm then
-      P.OSes := P.OSes - [android];
     P.Dependencies.Add('fcl-json');
     P.Dependencies.Add('fcl-js');
     P.Dependencies.Add('fcl-passrc');

utils/pas2js/httpcompiler.pp

@@ -7,7 +7,8 @@ interface
 
 uses
   sysutils, classes, fpjson, contnrs, syncobjs, custhttpapp, fpwebfile, httproute,
-  pas2jscompiler, httpdefs, dirwatch;
+  httpdefs, dirwatch,
+  Pas2JSFSCompiler, Pas2JSCompilerCfg;
 
 Const
   nErrTooManyThreads = -1;
@@ -89,7 +90,10 @@ Type
     FDW : TDirWatcher;
     FStatusList : TFPObjectList;
     FCompiles : TCompiles;
+    FServeOnly  : Boolean;
     procedure AddToStatus(O: TJSONObject);
+    function HandleCompileOptions(aDir: String): Boolean;
+    function ProcessOptions: Boolean;
     Procedure ReportBuilding(AItem : TCompileItem);
     Procedure ReportBuilt(AItem : TCompileItem);
     Procedure AddToStatus(AEntry : TDirectoryEntry; AEvents : TFileEvents);
@@ -98,6 +102,7 @@ Type
     function ScheduleCompile(const aProjectFile: String; Options : TStrings = Nil): Integer;
     procedure StartWatch(ADir: String);
     procedure Usage(Msg: String);
+    function GetDefaultMimetypes: string;
   public
     Constructor Create(AOWner : TComponent); override;
     Destructor Destroy; override;
@@ -108,6 +113,7 @@ Type
     Property ProjectFile : String Read FProjectFile Write FProjectFile;
     Property ConfigFile : String Read FConfigFile Write FConfigFile;
     Property BaseDir : String Read FBaseDir;
+    Property ServeOnly : Boolean Read FServeOnly;
   end;
 
 Implementation
@@ -138,13 +144,14 @@ end;
 procedure TCompileThread.Execute;
 
 Var
-  C : TPas2jsCompiler;
+  C : TPas2JSFSCompiler;
   L : TStrings;
 
 begin
   L:=Nil;
-  C:=TPas2jsCompiler.Create;
+  C:=TPas2JSFSCompiler.Create;
   Try
+    C.ConfigSupport:=TPas2JSFileConfigSupport.Create(C);
     FApp.ReportBuilding(Item);
     L:=TStringList.Create;
     L.Assign(Item.Options);
@@ -255,10 +262,25 @@ begin
   Writeln('-q --quiet          Do not write diagnostic messages');
   Writeln('-w --watch          Watch directory for changes');
   Writeln('-c --compile[=proj] Recompile project if pascal files change. Default project is app.lpr');
+  Writeln('-m --mimetypes=file filename of mimetypes. Default is ',GetDefaultMimetypes);
+  Writeln('-s --simpleserver   Only serve files, do not enable compilation.');
   Halt(Ord(Msg<>''));
   {AllowWriteln-}
 end;
 
+function THTTPCompilerApplication.GetDefaultMimetypes: string;
+begin
+  {$ifdef unix}
+  Result:='/etc/mime.types';
+  {$ifdef darwin}
+  if not FileExists(Result) then
+    Result:='/private/etc/apache2/mime.types';
+  {$endif}
+  {$else}
+  Result:=ExtractFilePath(System.ParamStr(0))+'mime.types';
+  {$endif}
+end;
+
 constructor THTTPCompilerApplication.Create(AOWner: TComponent);
 begin
   inherited Create(AOWner);
@@ -398,7 +420,8 @@ begin
   end;
 end;
 
-Function THTTPCompilerApplication.ScheduleCompile(const aProjectFile : String; Options : TStrings = Nil) : Integer;
+function THTTPCompilerApplication.ScheduleCompile(const aProjectFile: String;
+  Options: TStrings): Integer;
 
 Var
   CI : TCompileItem;
@@ -474,32 +497,16 @@ begin
   AResponse.SendResponse;
 end;
 
-procedure THTTPCompilerApplication.DoRun;
-
-Var
-  S,IndexPage,D : String;
+function THTTPCompilerApplication.HandleCompileOptions(aDir: String): Boolean;
 
 begin
-  S:=Checkoptions('hqd:ni:p:wP::c',['help','quiet','noindexpage','directory:','port:','indexpage:','watch','project::','config:']);
-  if (S<>'') or HasOption('h','help') then
-    usage(S);
-  Quiet:=HasOption('q','quiet');
+  Result:=False;
   Watch:=HasOption('w','watch');
-  Port:=StrToIntDef(GetOptionValue('p','port'),3000);
-  D:=GetOptionValue('d','directory');
-  if D='' then
-    D:=GetCurrentDir;
-  Log(etInfo,'Listening on port %d, serving files from directory: %s',[Port,D]);
-{$ifdef unix}
-  MimeTypesFile:='/etc/mime.types';
-{$else}
-  MimeTypesFile:=ExtractFilePath(System.ParamStr(0))+'mime.types';
-{$endif}
   if Hasoption('P','project') then
     begin
     ProjectFile:=GetOptionValue('P','project');
     if ProjectFile='' then
-      ProjectFile:=IncludeTrailingPathDelimiter(D)+'app.lpr';
+      ProjectFile:=IncludeTrailingPathDelimiter(aDir)+'app.lpr';
     If Not FileExists(ProjectFile) then
       begin
       Terminate;
@@ -516,11 +523,42 @@ begin
     begin
     if (ProjectFile='') then
       Log(etWarning,'No project file specified, disabling watch.')   ;
-    StartWatch(D);
+    StartWatch(aDir);
     end;
+  Result:=True;
+end;
+
+function THTTPCompilerApplication.ProcessOptions: Boolean;
+
+Var
+  S,IndexPage,D : String;
+
+begin
+  Result:=False;
+  S:=Checkoptions('shqd:ni:p:wP::cm:',['help','quiet','noindexpage','directory:','port:','indexpage:','watch','project::','config:','simpleserver','mimetypes:']);
+  if (S<>'') or HasOption('h','help') then
+    usage(S);
+  FServeOnly:=HasOption('s','serve-only');
+  Quiet:=HasOption('q','quiet');
+  Port:=StrToIntDef(GetOptionValue('p','port'),3000);
+  D:=GetOptionValue('d','directory');
+  if D='' then
+    D:=GetCurrentDir;
+  if HasOption('m','mimetypes') then
+    MimeTypesFile:=GetOptionValue('m','mimetypes');
+  if MimeTypesFile='' then
+    MimeTypesFile:=GetDefaultMimetypes;
+  if (MimeTypesFile<>'') and not FileExists(MimeTypesFile) then
+    Log(etWarning,'mimetypes file not found: '+MimeTypesFile);
   FBaseDir:=D;
+  if not ServeOnly then
+    if not HandleCompileOptions(D) then
+      exit(False);
   TSimpleFileModule.BaseDir:=IncludeTrailingPathDelimiter(D);
   TSimpleFileModule.OnLog:=@Log;
+  Log(etInfo,'Listening on port %d, serving files from directory: %s',[Port,D]);
+  if ServeOnly then
+    Log(etInfo,'Compile requests will be ignored.');
   If not HasOption('n','noindexpage') then
     begin
     IndexPage:=GetOptionValue('i','indexpage');
@@ -529,8 +567,22 @@ begin
     Log(etInfo,'Using index page %s',[IndexPage]);
     TSimpleFileModule.IndexPageName:=IndexPage;
     end;
-  httprouter.RegisterRoute('$sys/compile',rmPost,@DoRecompile);
-  httprouter.RegisterRoute('$sys/status',rmGet,@DoStatusRequest);
+  Result:=True;
+end;
+
+procedure THTTPCompilerApplication.DoRun;
+
+begin
+  If not ProcessOptions then
+    begin
+    Terminate;
+    exit;
+    end;
+  if not ServeOnly then
+    begin
+    httprouter.RegisterRoute('$sys/compile',rmPost,@DoRecompile);
+    httprouter.RegisterRoute('$sys/status',rmGet,@DoStatusRequest);
+    end;
   TSimpleFileModule.RegisterDefaultRoute;
   inherited;
 end;