Browse Source

* Add SQLDB Rest Bridge

git-svn-id: trunk@41431 -
michael 6 years ago
parent
commit
2845fabd02

+ 14 - 0
.gitattributes

@@ -3315,6 +3315,8 @@ 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/demorestbridge.lpi svneol=native#text/plain
+packages/fcl-web/examples/restbridge/demorestbridge.pp 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
@@ -3448,6 +3450,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

+ 62 - 0
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>

+ 145 - 0
packages/fcl-web/examples/restbridge/demorestbridge.pp

@@ -0,0 +1,145 @@
+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','FPC','Shimrod',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.
+

+ 80 - 0
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;

+ 249 - 0
packages/fcl-web/src/restbridge/sqldbrestauth.pp

@@ -0,0 +1,249 @@
+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.
+

+ 197 - 0
packages/fcl-web/src/restbridge/sqldbrestauthini.pp

@@ -0,0 +1,197 @@
+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.
+

+ 1790 - 0
packages/fcl-web/src/restbridge/sqldbrestbridge.pp

@@ -0,0 +1,1790 @@
+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.
+

+ 306 - 0
packages/fcl-web/src/restbridge/sqldbrestcds.pp

@@ -0,0 +1,306 @@
+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.
+

+ 43 - 0
packages/fcl-web/src/restbridge/sqldbrestconst.pp

@@ -0,0 +1,43 @@
+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.
+

+ 196 - 0
packages/fcl-web/src/restbridge/sqldbrestcsv.pp

@@ -0,0 +1,196 @@
+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.
+

+ 866 - 0
packages/fcl-web/src/restbridge/sqldbrestdata.pp

@@ -0,0 +1,866 @@
+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.
+

+ 559 - 0
packages/fcl-web/src/restbridge/sqldbrestini.pp

@@ -0,0 +1,559 @@
+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.
+                          );
+  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;
+
+
+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';
+
+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;
+
+
+
+{ 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;
+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);
+  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;
+  Aini.UpdateFile;
+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);
+  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.

+ 837 - 0
packages/fcl-web/src/restbridge/sqldbrestio.pp

@@ -0,0 +1,837 @@
+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.
+

+ 243 - 0
packages/fcl-web/src/restbridge/sqldbrestjson.pp

@@ -0,0 +1,243 @@
+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.
+

+ 1084 - 0
packages/fcl-web/src/restbridge/sqldbrestschema.pp

@@ -0,0 +1,1084 @@
+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.
+

+ 301 - 0
packages/fcl-web/src/restbridge/sqldbrestxml.pp

@@ -0,0 +1,301 @@
+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.
+