* rebase to trunk@17295avr

git-svn-id: http://svn.freepascal.org/svn/fpc/branches/avr@17296 3ad0048d-3df7-0310-abae-a5850022a9f2

10 files changed, 582 insertions, 145 deletions

diff --git a/packages/fcl-web/src/base/custfcgi.pp b/packages/fcl-web/src/base/custfcgi.pp
index 65660994fd..4be71d53f1 100644
--- a/packages/fcl-web/src/base/custfcgi.pp
+++ b/packages/fcl-web/src/base/custfcgi.pp
@@ -21,7 +21,13 @@ unit custfcgi;
 Interface
 
 uses
-  Classes,SysUtils, httpdefs,custweb, custcgi, fastcgi;
+  Classes,SysUtils, httpdefs, 
+{$ifdef unix}
+  BaseUnix, TermIO,
+{$else}
+  winsock2,
+{$endif}
+  Sockets, custweb, custcgi, fastcgi;
 
 Type
   { TFCGIRequest }
@@ -29,7 +35,8 @@ Type
   TFCGIRequest = Class;
   TFCGIResponse = Class;
 
-  TProtocolOption = (poNoPadding,poStripContentLength, poFailonUnknownRecord );
+  TProtocolOption = (poNoPadding,poStripContentLength, poFailonUnknownRecord,
+                     poReuseAddress, poUseSelect );
   TProtocolOptions = Set of TProtocolOption;
 
   TUnknownRecordEvent = Procedure (ARequest : TFCGIRequest; AFCGIRecord: PFCGI_Header) Of Object;
@@ -60,9 +67,7 @@ Type
 
   TFCGIResponse = Class(TCGIResponse)
   private
-    FNoPadding: Boolean;
     FPO: TProtoColOptions;
-    FStripCL: Boolean;
     procedure Write_FCGIRecord(ARecord : PFCGI_Header);
   Protected
     Procedure DoSendHeaders(Headers : TStrings); override;
@@ -75,6 +80,8 @@ Type
              Response : TFCgiResponse;
              end;
 
+  { TFCgiHandler }
+
   TFCgiHandler = class(TWebHandler)
   Private
     FOnUnknownRecord: TUnknownRecordEvent;
@@ -84,10 +91,14 @@ Type
     FHandle : THandle;
     Socket: longint;
     FAddress: string;
+    FTimeOut,
     FPort: integer;
     function Read_FCGIRecord : PFCGI_Header;
+    function DataAvailable : Boolean;
   protected
-    function WaitForRequest(out ARequest : TRequest; out AResponse : TResponse) : boolean; override;
+    function  ProcessRecord(AFCGI_Record: PFCGI_Header; out ARequest: TRequest;  out AResponse: TResponse): boolean; virtual;
+    procedure SetupSocket(var IAddress: TInetSockAddr;  var AddressLength: tsocklen); virtual;
+    function  WaitForRequest(out ARequest : TRequest; out AResponse : TResponse) : boolean; override;
     procedure EndRequest(ARequest : TRequest;AResponse : TResponse); override;
   Public
     constructor Create(AOwner: TComponent); override;
@@ -96,6 +107,7 @@ Type
     property Address: string read FAddress write FAddress;
     Property ProtocolOptions : TProtoColOptions Read FPO Write FPO;
     Property OnUnknownRecord : TUnknownRecordEvent Read FOnUnknownRecord Write FOnUnknownRecord;
+    Property TimeOut : Integer Read FTimeOut Write FTimeOut;
   end;
 
   { TCustomFCgiApplication }
@@ -126,14 +138,16 @@ ResourceString
   SListenFailed     = 'Failed to listen to port %d. Socket Error: %d';
   SErrReadingSocket = 'Failed to read data from socket. Error: %d';
   SErrReadingHeader = 'Failed to read FastCGI header. Read only %d bytes';
+  SErrWritingSocket = 'Failed to write data to socket. Error: %d';
 
 Implementation
 
-uses
 {$ifdef CGIDEBUG}
-  dbugintf,
+uses
+  dbugintf;
 {$endif}
-  Sockets;
+ 
+
 
 {$undef nosignal}
 
@@ -315,9 +329,13 @@ begin
   P:=PByte(Arecord);
   Repeat
     BytesWritten := sockets.fpsend(TFCGIRequest(Request).Handle, P, BytesToWrite, NoSignalAttr);
+    If (BytesWritten<0) then
+      begin
+      // TODO : Better checking for closed connection, EINTR
+      Raise HTTPError.CreateFmt(SErrWritingSocket,[BytesWritten]);
+      end;
     Inc(P,BytesWritten);
     Dec(BytesToWrite,BytesWritten);
-//    Assert(BytesWritten=BytesToWrite);
   until (BytesToWrite=0) or (BytesWritten=0);
 end;
 
@@ -346,15 +364,18 @@ begin
     pl := 8-(cl mod 8);
   ARespRecord:=nil;
   Getmem(ARespRecord,8+cl+pl);
-  FillChar(ARespRecord^,8+cl+pl,0);
-  ARespRecord^.header.version:=FCGI_VERSION_1;
-  ARespRecord^.header.reqtype:=FCGI_STDOUT;
-  ARespRecord^.header.paddingLength:=pl;
-  ARespRecord^.header.contentLength:=NtoBE(cl);
-  ARespRecord^.header.requestId:=NToBE(TFCGIRequest(Request).RequestID);
-  move(str[1],ARespRecord^.ContentData,cl);
-  Write_FCGIRecord(PFCGI_Header(ARespRecord));
-  Freemem(ARespRecord);
+  try
+    FillChar(ARespRecord^,8+cl+pl,0);
+    ARespRecord^.header.version:=FCGI_VERSION_1;
+    ARespRecord^.header.reqtype:=FCGI_STDOUT;
+    ARespRecord^.header.paddingLength:=pl;
+    ARespRecord^.header.contentLength:=NtoBE(cl);
+    ARespRecord^.header.requestId:=NToBE(TFCGIRequest(Request).RequestID);
+    move(str[1],ARespRecord^.ContentData,cl);
+    Write_FCGIRecord(PFCGI_Header(ARespRecord));
+  finally
+    Freemem(ARespRecord);
+  end;
 end;
 
 procedure TFCGIResponse.DoSendContent;
@@ -392,14 +413,17 @@ begin
       pl := 8-(cl mod 8);
     ARespRecord:=Nil;
     Getmem(ARespRecord,8+cl+pl);
-    ARespRecord^.header.version:=FCGI_VERSION_1;
-    ARespRecord^.header.reqtype:=FCGI_STDOUT;
-    ARespRecord^.header.paddingLength:=pl;
-    ARespRecord^.header.contentLength:=NtoBE(cl);
-    ARespRecord^.header.requestId:=NToBE(TFCGIRequest(Request).RequestID);
-    move(Str[BS+1],ARespRecord^.ContentData,cl);
-    Write_FCGIRecord(PFCGI_Header(ARespRecord));
-    Freemem(ARespRecord);
+    try
+      ARespRecord^.header.version:=FCGI_VERSION_1;
+      ARespRecord^.header.reqtype:=FCGI_STDOUT;
+      ARespRecord^.header.paddingLength:=pl;
+      ARespRecord^.header.contentLength:=NtoBE(cl);
+      ARespRecord^.header.requestId:=NToBE(TFCGIRequest(Request).RequestID);
+      move(Str[BS+1],ARespRecord^.ContentData,cl);
+      Write_FCGIRecord(PFCGI_Header(ARespRecord));
+    finally
+      Freemem(ARespRecord);
+    end;
     Inc(BS,cl);
   Until (BS=L);
   FillChar(EndRequest,SizeOf(FCGI_EndRequestRecord),0);
@@ -420,6 +444,7 @@ begin
   FRequestsAvail:=5;
   SetLength(FRequestsArray,FRequestsAvail);
   FHandle := THandle(-1);
+  FTimeOut:=50;
 end;
 
 destructor TFCgiHandler.Destroy;
@@ -452,6 +477,30 @@ begin
 end;
 
 function TFCgiHandler.Read_FCGIRecord : PFCGI_Header;
+{ $DEFINE DUMPRECORD}
+{$IFDEF DUMPRECORD}
+  Procedure DumpFCGIRecord (Var Header :FCGI_Header; ContentLength : word; PaddingLength : byte; ResRecord : Pointer);
+
+  Var
+    s : string;
+    I : Integer;
+
+  begin
+      Writeln('Dumping record ', Sizeof(Header),',',Contentlength,',',PaddingLength);
+      For I:=0 to Sizeof(Header)+ContentLength+PaddingLength-1 do
+        begin
+        Write(Format('%:3d ',[PByte(ResRecord)[i]]));
+        If PByte(ResRecord)[i]>30 then
+          S:=S+char(PByte(ResRecord)[i]);
+        if (I mod 16) = 0 then
+           begin
+           writeln('  ',S);
+           S:='';
+           end;
+        end;
+      Writeln('  ',S)
+  end;
+{$ENDIF DUMPRECORD}
 
   function ReadBytes(ReadBuf: Pointer; ByteAmount : Word) : Integer;
 
@@ -477,12 +526,11 @@ function TFCgiHandler.Read_FCGIRecord : PFCGI_Header;
   end;
 
 var Header : FCGI_Header;
-    {I,}BytesRead : integer;
+    BytesRead : integer;
     ContentLength : word;
     PaddingLength : byte;
     ResRecord : pointer;
     ReadBuf : pointer;
-    s : string;
 
 
 begin
@@ -490,119 +538,183 @@ begin
   ResRecord:=Nil;
   ReadBuf:=@Header;
   BytesRead:=ReadBytes(ReadBuf,Sizeof(Header));
-  If (BytesRead<>Sizeof(Header)) then
+  If (BytesRead=0) then
+    Exit // Connection closed gracefully.
+    // TODO : if connection closed gracefully, the request should no longer be handled.
+    // Need to discard request/response
+  else If (BytesRead<>Sizeof(Header)) then
     Raise HTTPError.CreateFmt(SErrReadingHeader,[BytesRead]);
   ContentLength:=BetoN(Header.contentLength);
   PaddingLength:=Header.paddingLength;
   Getmem(ResRecord,BytesRead+ContentLength+PaddingLength);
-  PFCGI_Header(ResRecord)^:=Header;
-  ReadBuf:=ResRecord+BytesRead;
-  BytesRead:=ReadBytes(ReadBuf,ContentLength);
-  ReadBuf:=ReadBuf+BytesRead;
-  BytesRead:=ReadBytes(ReadBuf,PaddingLength);
-  Result := ResRecord;
-{
-  Writeln('Dumping record ', Sizeof(Header),',',Contentlength,',',PaddingLength);
-  For I:=0 to Sizeof(Header)+ContentLength+PaddingLength-1 do
+  try
+    PFCGI_Header(ResRecord)^:=Header;
+    ReadBuf:=ResRecord+BytesRead;
+    BytesRead:=ReadBytes(ReadBuf,ContentLength);
+    If (BytesRead=0) and (ContentLength>0) then
+      begin
+      FreeMem(resRecord);
+      Exit // Connection closed gracefully.
+      // TODO : properly handle connection close
+      end;
+    ReadBuf:=ReadBuf+BytesRead;
+    BytesRead:=ReadBytes(ReadBuf,PaddingLength);
+    If (BytesRead=0) and (PaddingLength>0) then
+      begin
+      FreeMem(resRecord);
+      Exit // Connection closed gracefully.
+      // TODO : properly handle connection close
+      end;
+    Result := ResRecord;
+  except
+    FreeMem(resRecord);
+    Raise;
+  end;
+end;
+
+procedure TFCgiHandler.SetupSocket(var IAddress : TInetSockAddr; Var AddressLength : tsocklen);
+
+begin
+  AddressLength:=Sizeof(IAddress);
+  Socket := fpsocket(AF_INET,SOCK_STREAM,0);
+  if Socket=-1 then
+    raise EFPWebError.CreateFmt(SNoSocket,[socketerror]);
+  IAddress.sin_family:=AF_INET;
+  IAddress.sin_port:=htons(Port);
+  if FAddress<>'' then
+    Iaddress.sin_addr := StrToHostAddr(FAddress)
+  else
+    IAddress.sin_addr.s_addr:=0;
+    {$IFDEF Unix}
+    // remedy socket port locking on Posix platforms
+    If (poReuseAddress in ProtocolOptions) then
+      fpSetSockOpt(Socket, SOL_SOCKET, SO_REUSEADDR, @IAddress, SizeOf(IAddress));
+    {$ENDIF}
+  if fpbind(Socket,@IAddress,AddressLength)=-1 then
+    begin
+    CloseSocket(socket);
+    Socket:=0;
+    Terminate;
+    raise Exception.CreateFmt(SBindFailed,[port,socketerror]);
+    end;
+  if fplisten(Socket,1)=-1 then
     begin
-    Write(Format('%:3d ',[PByte(ResRecord)[i]]));
-    If PByte(ResRecord)[i]>30 then
-      S:=S+char(PByte(ResRecord)[i]);
-    if (I mod 16) = 0 then
-       begin
-       writeln('  ',S);
-       S:='';
-       end;
+    CloseSocket(socket);
+    Socket:=0;
+    Terminate;
+    raise Exception.CreateFmt(SListenFailed,[port,socketerror]);
+    end;
+end;
+
+{$ifdef unix}
+function TFCgiHandler.DataAvailable: Boolean;
+
+var
+  FDS: TFDSet;
+  TimeV: TTimeVal;
+
+begin
+  fpFD_Zero(FDS);
+  fpFD_Set(FHandle, FDS);
+  TimeV.tv_usec := (Timeout mod 1000) * 1000;
+  TimeV.tv_sec := Timeout div 1000;
+  Result := fpSelect(FHandle + 1, @FDS, @FDS, @FDS, @TimeV) > 0;
+end;
+{$else}
+function TFCgiHandler.DataAvailable: Boolean;
+
+var
+  FDS: TFDSet;
+  TimeV: TTimeVal;
+
+begin
+  FD_Zero(FDS);
+  FD_Set(FHandle, FDS);
+  TimeV.tv_usec := (Timeout mod 1000) * 1000;
+  TimeV.tv_sec := Timeout div 1000;
+  Result := Select(FHandle + 1, @FDS, @FDS, @FDS, @TimeV) <> 0;
+end;
+{$endif}
+
+function TFCgiHandler.ProcessRecord(AFCGI_Record  : PFCGI_Header; out ARequest: TRequest; out AResponse: TResponse): boolean;
+
+var
+  ARequestID    : word;
+  ATempRequest  : TFCGIRequest;
+begin
+  Result:=False;
+  ARequestID:=BEtoN(AFCGI_Record^.requestID);
+  if AFCGI_Record^.reqtype = FCGI_BEGIN_REQUEST then
+    begin
+    if ARequestID>FRequestsAvail then
+      begin
+      inc(FRequestsAvail,10);
+      SetLength(FRequestsArray,FRequestsAvail);
+      end;
+    assert(not assigned(FRequestsArray[ARequestID].Request));
+    assert(not assigned(FRequestsArray[ARequestID].Response));
+    ATempRequest:=TFCGIRequest.Create;
+    ATempRequest.RequestID:=ARequestID;
+    ATempRequest.Handle:=FHandle;
+    ATempRequest.ProtocolOptions:=Self.Protocoloptions;
+    ATempRequest.OnUnknownRecord:=Self.OnUnknownRecord;
+    FRequestsArray[ARequestID].Request := ATempRequest;
+    end;
+  if (ARequestID>FRequestsAvail) then
+    begin
+    // TODO : ARequestID can be invalid. What to do ?
+    // in each case not try to access the array with requests.
+    end
+  else if FRequestsArray[ARequestID].Request.ProcessFCGIRecord(AFCGI_Record) then
+    begin
+    ARequest:=FRequestsArray[ARequestID].Request;
+    FRequestsArray[ARequestID].Response := TFCGIResponse.Create(ARequest);
+    FRequestsArray[ARequestID].Response.ProtocolOptions:=Self.ProtocolOptions;
+    AResponse:=FRequestsArray[ARequestID].Response;
+    Result := True;
     end;
-  Writeln('  ',S)
-}
 end;
 
 function TFCgiHandler.WaitForRequest(out ARequest: TRequest; out AResponse: TResponse): boolean;
+
 var
   IAddress      : TInetSockAddr;
   AddressLength : tsocklen;
-  ARequestID    : word;
   AFCGI_Record  : PFCGI_Header;
-  ATempRequest  : TFCGIRequest;
 
 begin
   Result := False;
-  AddressLength:=Sizeof(IAddress);
-
   if Socket=0 then
-    begin
     if Port<>0 then
-      begin
-      Socket := fpsocket(AF_INET,SOCK_STREAM,0);
-      if Socket=-1 then
-        raise EFPWebError.CreateFmt(SNoSocket,[socketerror]);
-      IAddress.sin_family:=AF_INET;
-      IAddress.sin_port:=htons(Port);
-      if FAddress<>'' then
-        Iaddress.sin_addr := StrToHostAddr(FAddress)
-      else
-        IAddress.sin_addr.s_addr:=0;
-      if fpbind(Socket,@IAddress,AddressLength)=-1 then
-        begin
-        CloseSocket(socket);
-        Socket:=0;
-        raise Exception.CreateFmt(SBindFailed,[port,socketerror]);
-        end;
-      if fplisten(Socket,1)=-1 then
-        begin
-        CloseSocket(socket);
-        Socket:=0;
-        raise Exception.CreateFmt(SListenFailed,[port,socketerror]);
-        end;
-      end
+      SetupSocket(IAddress,AddressLength)
     else
       Socket:=StdInputHandle;
-    end;
-
   if FHandle=THandle(-1) then
     begin
     FHandle:=fpaccept(Socket,psockaddr(@IAddress),@AddressLength);
     if FHandle=THandle(-1) then
+      begin
+      Terminate;
       raise Exception.CreateFmt(SNoInputHandle,[socketerror]);
+      end;
     end;
-
   repeat
-  AFCGI_Record:=Read_FCGIRecord;
-  if assigned(AFCGI_Record) then
+    If (poUseSelect in ProtocolOptions) then
+      begin
+      While Not DataAvailable do
+        If (OnIdle<>Nil) then
+          OnIdle(Self);
+      end;
+    AFCGI_Record:=Read_FCGIRecord;
+
+    if assigned(AFCGI_Record) then
     try
-      ARequestID:=BEtoN(AFCGI_Record^.requestID);
-      if AFCGI_Record^.reqtype = FCGI_BEGIN_REQUEST then
-        begin
-        if ARequestID>FRequestsAvail then
-          begin
-          inc(FRequestsAvail,10);
-          SetLength(FRequestsArray,FRequestsAvail);
-          end;
-        assert(not assigned(FRequestsArray[ARequestID].Request));
-        assert(not assigned(FRequestsArray[ARequestID].Response));
-
-        ATempRequest:=TFCGIRequest.Create;
-        ATempRequest.RequestID:=ARequestID;
-        ATempRequest.Handle:=FHandle;
-        ATempRequest.ProtocolOptions:=Self.Protocoloptions;
-        ATempRequest.OnUnknownRecord:=Self.OnUnknownRecord;
-        FRequestsArray[ARequestID].Request := ATempRequest;
-        end;
-      if FRequestsArray[ARequestID].Request.ProcessFCGIRecord(AFCGI_Record) then
-        begin
-        ARequest:=FRequestsArray[ARequestID].Request;
-        FRequestsArray[ARequestID].Response := TFCGIResponse.Create(ARequest);
-        FRequestsArray[ARequestID].Response.ProtocolOptions:=Self.ProtocolOptions;
-        AResponse:=FRequestsArray[ARequestID].Response;
-        Result := True;
-        Break;
-        end;
+      Result:=ProcessRecord(AFCGI_Record,ARequest,AResponse);
     Finally
       FreeMem(AFCGI_Record);
       AFCGI_Record:=Nil;
     end;
-  until (1<>1);
+  until Result;
 end;
 
 { TCustomFCgiApplication }
diff --git a/packages/fcl-web/src/base/custweb.pp b/packages/fcl-web/src/base/custweb.pp
index 20b35f60f8..f0820619dd 100644
--- a/packages/fcl-web/src/base/custweb.pp
+++ b/packages/fcl-web/src/base/custweb.pp
@@ -557,6 +557,7 @@ end;
 
 constructor TCustomWebApplication.Create(AOwner: TComponent);
 begin
+  Inherited Create(AOwner);
   FWebHandler := InitializeWebHandler;
   FWebHandler.FOnTerminate:=@DoOnTerminate;
 end;
diff --git a/packages/fcl-web/src/base/fphtml.pp b/packages/fcl-web/src/base/fphtml.pp
index 6c5bdb96d5..a6645732c1 100644
--- a/packages/fcl-web/src/base/fphtml.pp
+++ b/packages/fcl-web/src/base/fphtml.pp
@@ -42,15 +42,18 @@ type
   TWebController = class;
   THTMLContentProducer = class;
 
+  TJavaType = (jtOther, jtClientSideEvent);
+
   TJavaScriptStack = class(TObject)
   private
+    FJavaType: TJavaType;
     FMessageBoxHandler: TMessageBoxHandler;
     FScript: TStrings;
     FWebController: TWebController;
   protected
     function GetWebController: TWebController;
   public
-    constructor Create(const AWebController: TWebController); virtual;
+    constructor Create(const AWebController: TWebController; const AJavaType: TJavaType); virtual;
     destructor Destroy; override;
     procedure AddScriptLine(ALine: String); virtual;
     procedure MessageBox(AText: String; Buttons: TWebButtons; Loaded: string = ''); virtual;
@@ -61,6 +64,7 @@ type
     function ScriptIsEmpty: Boolean; virtual;
     function GetScript: String; virtual;
     property WebController: TWebController read GetWebController;
+    property JavaType: TJavaType read FJavaType;
   end;
 
   { TContainerStylesheet }
@@ -85,6 +89,35 @@ type
     property Items[Index: integer]: TContainerStylesheet read GetItem write SetItem;
   end;
 
+  { TJavaVariable }
+
+  TJavaVariable = class(TCollectionItem)
+  private
+    FBelongsTo: string;
+    FGetValueFunc: string;
+    FID: string;
+    FIDSuffix: string;
+    FName: string;
+  public
+    property BelongsTo: string read FBelongsTo write FBelongsTo;
+    property GetValueFunc: string read FGetValueFunc write FGetValueFunc;
+    property Name: string read FName write FName;
+    property ID: string read FID write FID;
+    property IDSuffix: string read FIDSuffix write FIDSuffix;
+  end;
+
+  { TJavaVariables }
+
+  TJavaVariables = class(TCollection)
+  private
+    function GetItem(Index: integer): TJavaVariable;
+    procedure SetItem(Index: integer; const AValue: TJavaVariable);
+  public
+    function Add: TJavaVariable;
+    property Items[Index: integer]: TJavaVariable read GetItem write SetItem;
+  end;
+
+
   { TWebController }
 
   TWebController = class(TComponent)
@@ -94,9 +127,13 @@ type
     FMessageBoxHandler: TMessageBoxHandler;
     FScriptName: string;
     FScriptStack: TFPObjectList;
+    FIterationIDs: array of string;
+    FJavaVariables: TJavaVariables;
     procedure SetBaseURL(const AValue: string);
     procedure SetScriptName(const AValue: string);
   protected
+    function GetJavaVariables: TJavaVariables;
+    function GetJavaVariablesCount: integer;
     function GetScriptFileReferences: TStringList; virtual; abstract;
     function GetCurrentJavaScriptStack: TJavaScriptStack; virtual;
     function GetStyleSheetReferences: TContainerStylesheets; virtual; abstract;
@@ -107,8 +144,8 @@ type
     destructor Destroy; override;
     procedure AddScriptFileReference(AScriptFile: String); virtual; abstract;
     procedure AddStylesheetReference(Ahref, Amedia: String); virtual; abstract;
-    function CreateNewJavascriptStack: TJavaScriptStack; virtual; abstract;
-    function InitializeJavaScriptStack: TJavaScriptStack;
+    function CreateNewJavascriptStack(AJavaType: TJavaType): TJavaScriptStack; virtual; abstract;
+    function InitializeJavaScriptStack(AJavaType: TJavaType): TJavaScriptStack;
     procedure FreeJavascriptStack; virtual;
     function HasJavascriptStack: boolean; virtual; abstract;
     function GetUrl(ParamNames, ParamValues, KeepParams: array of string; Action: string = ''): string; virtual; abstract;
@@ -117,12 +154,20 @@ type
     procedure CleanupShowRequest; virtual;
     procedure CleanupAfterRequest; virtual;
     procedure BeforeGenerateHead; virtual;
+    function AddJavaVariable(AName, ABelongsTo, AGetValueFunc, AID, AIDSuffix: string): TJavaVariable;
     procedure BindJavascriptCallstackToElement(AComponent: TComponent; AnElement: THtmlCustomElement; AnEvent: string); virtual; abstract;
     function MessageBox(AText: String; Buttons: TWebButtons; ALoaded: string = ''): string; virtual;
     function DefaultMessageBoxHandler(Sender: TObject; AText: String; Buttons: TWebButtons;  ALoaded: string = ''): string; virtual; abstract;
     function CreateNewScript: TStringList; virtual; abstract;
     function AddrelativeLinkPrefix(AnURL: string): string;
     procedure FreeScript(var AScript: TStringList); virtual; abstract;
+    procedure ShowRegisteredScript(ScriptID: integer); virtual; abstract;
+
+    function IncrementIterationLevel: integer; virtual;
+    procedure SetIterationIDSuffix(AIterationLevel: integer; IDSuffix: string); virtual;
+    function GetIterationIDSuffix: string; virtual;
+    procedure DecrementIterationLevel; virtual;
+
     property ScriptFileReferences: TStringList read GetScriptFileReferences;
     property StyleSheetReferences: TContainerStylesheets read GetStyleSheetReferences;
     property Scripts: TFPObjectList read GetScripts;
@@ -190,6 +235,7 @@ type
     FDocument: THTMLDocument;
     FElement: THTMLCustomElement;
     FWriter: THTMLWriter;
+    FIDSuffix: string;
     procedure SetDocument(const AValue: THTMLDocument);
     procedure SetWriter(const AValue: THTMLWriter);
   private
@@ -201,6 +247,8 @@ type
     procedure SetParent(const AValue: TComponent);
   Protected
     function CreateWriter (Doc : THTMLDocument) : THTMLWriter; virtual;
+    function GetIDSuffix: string; virtual;
+    procedure SetIDSuffix(const AValue: string); virtual;
   protected
     // Methods for streaming
     FAcceptChildsAtDesignTime: boolean;
@@ -211,6 +259,7 @@ type
     procedure AddEvent(var Events: TEventRecords; AServerEventID: integer; AServerEvent: THandleAjaxEvent; AJavaEventName: string; AcsCallBack: TCSAjaxEvent); virtual;
     procedure DoOnEventCS(AnEvent: TEventRecord; AJavascriptStack: TJavaScriptStack; var Handled: boolean); virtual;
     procedure SetupEvents(AHtmlElement: THtmlCustomElement); virtual;
+    function GetWebPage: TDataModule;
     function GetWebController(const ExceptIfNotAvailable: boolean = true): TWebController;
     property ContentProducerList: TFPList read GetContentProducerList;
   public
@@ -221,6 +270,7 @@ type
     property ParentElement : THTMLCustomElement read FElement write FElement;
     property Writer : THTMLWriter read FWriter write SetWriter;
     Property HTMLDocument : THTMLDocument read FDocument write SetDocument;
+    Property IDSuffix : string read GetIDSuffix write SetIDSuffix;
   public
     // for streaming
     constructor Create(AOwner: TComponent); override;
@@ -480,6 +530,23 @@ resourcestring
   SErrRequestNotHandled = 'Web request was not handled by actions.';
   SErrNoContentProduced = 'The content producer "%s" didn''t produce any content.';
 
+{ TJavaVariables }
+
+function TJavaVariables.GetItem(Index: integer): TJavaVariable;
+begin
+  result := TJavaVariable(Inherited GetItem(Index));
+end;
+
+procedure TJavaVariables.SetItem(Index: integer; const AValue: TJavaVariable);
+begin
+  inherited SetItem(Index, AValue);
+end;
+
+function TJavaVariables.Add: TJavaVariable;
+begin
+  result := inherited Add as TJavaVariable;
+end;
+
 { TcontainerStylesheets }
 
 function TcontainerStylesheets.GetItem(Index: integer): TContainerStylesheet;
@@ -505,10 +572,11 @@ begin
   result := FWebController;
 end;
 
-constructor TJavaScriptStack.Create(const AWebController: TWebController);
+constructor TJavaScriptStack.Create(const AWebController: TWebController; const AJavaType: TJavaType);
 begin
   FWebController := AWebController;
   FScript := TStringList.Create;
+  FJavaType := AJavaType;
 end;
 
 destructor TJavaScriptStack.Destroy;
@@ -591,6 +659,16 @@ begin
   Result:=THTMLContentProducer(ContentProducerList[Index]);
 end;
 
+function THTMLContentProducer.GetIDSuffix: string;
+begin
+  result := FIDSuffix;
+end;
+
+procedure THTMLContentProducer.SetIDSuffix(const AValue: string);
+begin
+  FIDSuffix := AValue;
+end;
+
 function THTMLContentProducer.GetContentProducerList: TFPList;
 begin
   if not assigned(FChilds) then
@@ -679,7 +757,7 @@ begin
     wc := GetWebController(false);
     if assigned(wc) then
       begin
-      AJSClass := wc.InitializeJavaScriptStack;
+      AJSClass := wc.InitializeJavaScriptStack(jtClientSideEvent);
       try
         for i := 0 to high(Events) do
           begin
@@ -702,24 +780,44 @@ begin
     end;
 end;
 
+function THTMLContentProducer.GetWebPage: TDataModule;
+var
+  aowner: TComponent;
+begin
+  result := nil;
+  aowner := Owner;
+  while assigned(aowner) do
+    begin
+    if aowner.InheritsFrom(TWebPage) then
+      begin
+      result := TWebPage(aowner);
+      break;
+      end;
+    aowner:=aowner.Owner;
+    end;
+end;
+
 function THTMLContentProducer.GetWebController(const ExceptIfNotAvailable: boolean): TWebController;
-var i : integer;
+var
+  i : integer;
+  wp: TWebPage;
 begin
   result := nil;
-  if assigned(owner)  then
+  wp := TWebPage(GetWebPage);
+  if assigned(wp) then
     begin
-    if (owner is TWebPage) and TWebPage(owner).HasWebController then
+    if wp.HasWebController then
       begin
-      result := TWebPage(owner).WebController;
+      result := wp.WebController;
       exit;
-      end
-    else //if (owner is TDataModule) then
+      end;
+    end
+  else if assigned(Owner) then //if (owner is TDataModule) then
+    begin
+    for i := 0 to owner.ComponentCount-1 do if owner.Components[i] is TWebController then
       begin
-      for i := 0 to owner.ComponentCount-1 do if owner.Components[i] is TWebController then
-        begin
-        result := TWebController(Owner.Components[i]);
-        Exit;
-        end;
+      result := TWebController(Owner.Components[i]);
+      Exit;
       end;
     end;
   if ExceptIfNotAvailable then
@@ -1199,7 +1297,7 @@ begin
   FSendXMLAnswer:=true;
   FResponse:=AResponse;
   FWebController := AWebController;
-  FJavascriptCallStack:=FWebController.InitializeJavaScriptStack;
+  FJavascriptCallStack:=FWebController.InitializeJavaScriptStack(jtOther);
 end;
 
 destructor TAjaxResponse.Destroy;
@@ -1248,6 +1346,21 @@ end;
 
 { TWebController }
 
+function TWebController.GetJavaVariables: TJavaVariables;
+begin
+  if not assigned(FJavaVariables) then
+    FJavaVariables := TJavaVariables.Create(TJavaVariable);
+  Result := FJavaVariables;
+end;
+
+function TWebController.GetJavaVariablesCount: integer;
+begin
+  if assigned(FJavaVariables) then
+    result := FJavaVariables.Count
+  else
+    result := 0;
+end;
+
 procedure TWebController.SetBaseURL(const AValue: string);
 begin
   if FBaseURL=AValue then exit;
@@ -1262,7 +1375,10 @@ end;
 
 function TWebController.GetCurrentJavaScriptStack: TJavaScriptStack;
 begin
-  result := TJavaScriptStack(FScriptStack.Items[FScriptStack.Count-1]);
+  if FScriptStack.Count>0 then
+    result := TJavaScriptStack(FScriptStack.Items[FScriptStack.Count-1])
+  else
+    result := nil;
 end;
 
 procedure TWebController.InitializeAjaxRequest;
@@ -1290,6 +1406,16 @@ begin
   // do nothing
 end;
 
+function TWebController.AddJavaVariable(AName, ABelongsTo, AGetValueFunc, AID, AIDSuffix: string): TJavaVariable;
+begin
+  result := GetJavaVariables.Add;
+  result.BelongsTo := ABelongsTo;
+  result.GetValueFunc := AGetValueFunc;
+  result.Name := AName;
+  result.IDSuffix := AIDSuffix;
+  result.ID := AID;
+end;
+
 function TWebController.MessageBox(AText: String; Buttons: TWebButtons; ALoaded: string = ''): string;
 begin
   if assigned(MessageBoxHandler) then
@@ -1308,6 +1434,36 @@ begin
     result := AnURL;
 end;
 
+function TWebController.IncrementIterationLevel: integer;
+begin
+  result := Length(FIterationIDs)+1;
+  SetLength(FIterationIDs,Result);
+end;
+
+procedure TWebController.SetIterationIDSuffix(AIterationLevel: integer; IDSuffix: string);
+begin
+  FIterationIDs[AIterationLevel-1]:=IDSuffix;
+end;
+
+function TWebController.GetIterationIDSuffix: string;
+var
+  i: integer;
+begin
+  result := '';
+  for i := 0 to length(FIterationIDs)-1 do
+    result := result + '_' + FIterationIDs[i];
+end;
+
+procedure TWebController.DecrementIterationLevel;
+var
+  i: integer;
+begin
+  i := length(FIterationIDs);
+  if i=0 then
+    raise Exception.Create('DecrementIterationLevel can not be called more times then IncrementIterationLevel');
+  SetLength(FIterationIDs,i-1);
+end;
+
 function TWebController.GetRequest: TRequest;
 begin
   if assigned(Owner) and (owner is TWebPage) then
@@ -1329,12 +1485,13 @@ begin
   if (Owner is TWebPage) and (TWebPage(Owner).WebController=self) then
     TWebPage(Owner).WebController := nil;
   FScriptStack.Free;
+  if assigned(FJavaVariables) then FJavaVariables.Free;
   inherited Destroy;
 end;
 
-function TWebController.InitializeJavaScriptStack: TJavaScriptStack;
+function TWebController.InitializeJavaScriptStack(AJavaType: TJavaType): TJavaScriptStack;
 begin
-  result := CreateNewJavascriptStack;
+  result := CreateNewJavascriptStack(AJavaType);
   FScriptStack.Add(result);
 end;
 
diff --git a/packages/fcl-web/src/base/webpage.pp b/packages/fcl-web/src/base/webpage.pp
index 21911f1e29..c644c57bf8 100644
--- a/packages/fcl-web/src/base/webpage.pp
+++ b/packages/fcl-web/src/base/webpage.pp
@@ -31,6 +31,13 @@ type
     property Designer: IWebPageDesigner read GetDesigner write SetDesigner;
   end;
 
+  IHTMLIterationGroup = interface(IUnknown)
+  ['{95575CB6-7D96-4F72-AF72-D2EAF0BECE71}']
+    procedure SetIDSuffix(const AHTMLContentProducer: THTMLContentProducer);
+    procedure SetAjaxIterationID(AValue: String);
+  end;
+
+
   { TStandardWebController }
 
   TStandardWebController = class(TWebController)
@@ -45,13 +52,14 @@ type
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
-    function CreateNewJavascriptStack: TJavaScriptStack; override;
+    function CreateNewJavascriptStack(AJavaType: TJavaType): TJavaScriptStack; override;
     function GetUrl(ParamNames, ParamValues, KeepParams: array of string; Action: string = ''): string; override;
     procedure BindJavascriptCallstackToElement(AComponent: TComponent; AnElement: THtmlCustomElement; AnEvent: string); override;
     procedure AddScriptFileReference(AScriptFile: String); override;
     procedure AddStylesheetReference(Ahref, Amedia: String); override;
     function DefaultMessageBoxHandler(Sender: TObject; AText: String; Buttons: TWebButtons; ALoaded: string = ''): string; override;
     function CreateNewScript: TStringList; override;
+    procedure ShowRegisteredScript(ScriptID: integer); override;
     procedure FreeScript(var AScript: TStringList); override;
   end;
 
@@ -114,9 +122,22 @@ type
     property BaseURL: string read FBaseURL write FBaseURL;
   end;
 
+  function RegisterScript(AScript: string) : integer;
+
 implementation
 
-uses rtlconsts, typinfo, XMLWrite;
+uses rtlconsts, typinfo, XMLWrite, strutils;
+
+var RegisteredScriptList : TStrings;
+
+function RegisterScript(AScript: string) : integer;
+begin
+  if not Assigned(RegisteredScriptList) then
+    begin
+    RegisteredScriptList := TStringList.Create;
+    end;
+  result := RegisteredScriptList.Add(AScript);
+end;
 
 { TWebPage }
 
@@ -184,6 +205,40 @@ var Handled: boolean;
     CompName: string;
     AComponent: TComponent;
     AnAjaxResponse: TAjaxResponse;
+    i: integer;
+    ASuffixID: string;
+    AIterationGroup: IHTMLIterationGroup;
+    AIterComp: TComponent;
+    wc: TWebController;
+    Iterationlevel: integer;
+
+  procedure SetIdSuffixes(AComp: THTMLContentProducer);
+  var
+    i: integer;
+    s: string;
+  begin
+    if assigned(AComp.parent) and (acomp.parent is THTMLContentProducer) then
+      SetIdSuffixes(THTMLContentProducer(AComp.parent));
+    if supports(AComp,IHTMLIterationGroup,AIterationGroup) then
+      begin
+        if assigned(FWebController) then
+          begin
+          iterationlevel := FWebController.IncrementIterationLevel;
+          assert(length(ASuffixID)>0);
+          i := PosEx('_',ASuffixID,2);
+          if i > 0 then
+            s := copy(ASuffixID,2,i-2)
+          else
+            s := copy(ASuffixID,2,length(ASuffixID)-1);
+
+          acomp.IDSuffix := s;
+          AIterationGroup.SetAjaxIterationID(s);
+          FWebController.SetIterationIDSuffix(iterationlevel,s);
+          acomp.ForeachContentProducer(@AIterationGroup.SetIDSuffix,true);
+          ASuffixID := copy(ASuffixID,i,length(ASuffixID)-i+1);
+          end;
+      end;
+  end;
 begin
   SetRequest(ARequest);
   FWebModule := AWebModule;
@@ -203,9 +258,28 @@ begin
               begin
               CompName := Request.QueryFields.Values['AjaxID'];
               if CompName='' then CompName := Request.GetNextPathInfo;
-              AComponent := FindComponent(CompName);
+
+              i := pos('$',CompName);
+              AComponent:=self;
+              while (i > 0) and (assigned(AComponent)) do
+                begin
+                AComponent := FindComponent(copy(CompName,1,i-1));
+                CompName := copy(compname,i+1,length(compname)-i);
+                i := pos('$',CompName);
+                end;
+              if assigned(AComponent) then
+                AComponent := AComponent.FindComponent(CompName);
+
               if assigned(AComponent) and (AComponent is THTMLContentProducer) then
+                begin
+                // Handle the SuffixID, search for iteration-groups and set their iteration-id-values
+                ASuffixID := ARequest.QueryFields.Values['IterationID'];
+                if ASuffixID<>'' then
+                  begin
+                  SetIdSuffixes(THTMLContentProducer(AComponent));
+                  end;
                 THTMLContentProducer(AComponent).HandleAjaxRequest(ARequest, AnAjaxResponse);
+                end;
               end;
             DoAfterAjaxRequest(ARequest, AnAjaxResponse);
           except on E: Exception do
@@ -346,8 +420,13 @@ end;
 function TWebPage.IsAjaxCall: boolean;
 var s : string;
 begin
-  s := Request.HTTPXRequestedWith;
-  result := sametext(s,'XmlHttpRequest');
+  if assigned(request) then
+    begin
+    s := Request.HTTPXRequestedWith;
+    result := sametext(s,'XmlHttpRequest');
+    end
+  else
+    result := false;
 end;
 
 { TStandardWebController }
@@ -378,6 +457,22 @@ begin
   GetScripts.Add(result);
 end;
 
+procedure TStandardWebController.ShowRegisteredScript(ScriptID: integer);
+var
+  i: Integer;
+  s: string;
+begin
+  s := '// ' + inttostr(ScriptID);
+  for i := 0 to GetScripts.Count -1 do
+    if tstrings(GetScripts.Items[i]).Strings[0]=s then
+      Exit;
+  with CreateNewScript do
+    begin
+    Append(s);
+    Append(RegisteredScriptList.Strings[ScriptID]);
+    end;
+end;
+
 procedure TStandardWebController.FreeScript(var AScript: TStringList);
 begin
   with GetScripts do
@@ -431,9 +526,9 @@ begin
   inherited Destroy;
 end;
 
-function TStandardWebController.CreateNewJavascriptStack: TJavaScriptStack;
+function TStandardWebController.CreateNewJavascriptStack(AJavaType: TJavaType): TJavaScriptStack;
 begin
-  Result:=TJavaScriptStack.Create(self);
+  Result:=TJavaScriptStack.Create(self, AJavaType);
 end;
 
 function TStandardWebController.GetUrl(ParamNames, ParamValues,
@@ -542,5 +637,10 @@ begin
     end;
 end;
 
+initialization
+  RegisteredScriptList := nil;
+finalization
+  if assigned(RegisteredScriptList) then
+    RegisteredScriptList.Free;
 end.
 
diff --git a/packages/fcl-web/src/base/websession.pp b/packages/fcl-web/src/base/websession.pp
index e4bb54c2cd..4a607db441 100644
--- a/packages/fcl-web/src/base/websession.pp
+++ b/packages/fcl-web/src/base/websession.pp
@@ -332,6 +332,7 @@ begin
       begin
 {$ifdef cgidebug}SendDebug('Getting default session');{$endif}
       FSession:=GetDefaultSession;
+      FSession.FreeNotification(Self);
       end;
     Result:=FSession
     end;
diff --git a/packages/fcl-web/src/jsonrpc/fpextdirect.pp b/packages/fcl-web/src/jsonrpc/fpextdirect.pp
index 645042ed26..c8fde13c81 100644
--- a/packages/fcl-web/src/jsonrpc/fpextdirect.pp
+++ b/packages/fcl-web/src/jsonrpc/fpextdirect.pp
@@ -130,6 +130,7 @@ Type
     Property DispatchOptions;
     Property APIPath;
     Property RouterPath;
+    Property CreateSession;
     Property NameSpace;
   end;
 
diff --git a/packages/fcl-web/src/jsonrpc/fpjsonrpc.pp b/packages/fcl-web/src/jsonrpc/fpjsonrpc.pp
index 8bb8676813..6fe9ba9d50 100644
--- a/packages/fcl-web/src/jsonrpc/fpjsonrpc.pp
+++ b/packages/fcl-web/src/jsonrpc/fpjsonrpc.pp
@@ -357,6 +357,10 @@ resourcestring
 
 implementation
 
+{$IFDEF WMDEBUG}
+uses dbugintf;
+{$ENDIF}
+
 function CreateJSONErrorObject(Const AMessage : String; Const ACode : Integer) : TJSONObject;
 
 begin
@@ -1014,7 +1018,7 @@ Var
 
 begin
   Result:=Nil;
-  {$ifdef wmdebug}SendDebug(Format('Creating instance for %s',[Self.ProviderName]));{$endif}
+  {$ifdef wmdebug}SendDebug(Format('Creating instance for %s',[Self.HandlerMethodName]));{$endif}
   If Assigned(FDataModuleClass) then
     begin
     {$ifdef wmdebug}SendDebug(Format('Creating datamodule from class %d ',[Ord(Assigned(FDataModuleClass))]));{$endif}
diff --git a/packages/fcl-web/src/webdata/extjsjson.pp b/packages/fcl-web/src/webdata/extjsjson.pp
index 447a223580..01595bdc74 100644
--- a/packages/fcl-web/src/webdata/extjsjson.pp
+++ b/packages/fcl-web/src/webdata/extjsjson.pp
@@ -28,6 +28,8 @@ type
   { TExtJSJSONDataFormatter }
   TJSONObjectEvent = Procedure(Sender : TObject; AObject : TJSONObject) of Object;
   TJSONExceptionObjectEvent = Procedure(Sender : TObject; E : Exception; AResponse : TJSONObject) of Object;
+  TJSONObjectAllowRowEvent = Procedure(Sender : TObject; Dataset : TDataset; Var Allow : Boolean) of Object;
+  TJSONObjectAllowEvent = Procedure(Sender : TObject; AObject : TJSONObject; Var Allow : Boolean) of Object;
 
   TExtJSJSONDataFormatter = Class(TExtJSDataFormatter)
   private
@@ -37,13 +39,18 @@ type
     FAfterRowToJSON: TJSONObjectEvent;
     FAfterUpdate: TJSONObjectEvent;
     FBeforeDataToJSON: TJSONObjectEvent;
+    FBeforeDelete: TNotifyEvent;
+    FBeforeInsert: TNotifyEvent;
     FBeforeRowToJSON: TJSONObjectEvent;
+    FBeforeUpdate: TNotifyEvent;
+    FOnAllowRow: TJSONObjectAllowRowEvent;
     FOnErrorResponse: TJSONExceptionObjectEvent;
     FOnMetaDataToJSON: TJSONObjectEvent;
     FBatchResult : TJSONArray;
     Function AddIdToBatch : TJSONObject;
     procedure SendSuccess(ResponseContent: TStream; AddIDValue : Boolean = False);
   protected
+    function AllowRow(ADataset : TDataset) : Boolean; virtual;
     Procedure StartBatch(ResponseContent : TStream); override;
     Procedure NextBatchItem(ResponseContent : TStream); override;
     Procedure EndBatch(ResponseContent : TStream); override;
@@ -77,12 +84,18 @@ type
     Property BeforeDataToJSON : TJSONObjectEvent Read FBeforeDataToJSON Write FBeforeDataToJSON;
     // Called when an exception is caught and formatted.
     Property OnErrorResponse : TJSONExceptionObjectEvent Read FOnErrorResponse Write FOnErrorResponse;
+    // Called to decide whether a record is sent to the client;
+    Property OnAllowRow : TJSONObjectAllowRowEvent Read FOnAllowRow Write FOnAllowRow;
     // After a record was succesfully updated
     Property AfterUpdate : TJSONObjectEvent Read FAfterUpdate Write FAfterUpdate;
     // After a record was succesfully inserted.
     Property AfterInsert : TJSONObjectEvent Read FAfterInsert Write FAfterInsert;
     // After a record was succesfully inserted.
     Property AfterDelete : TJSONObjectEvent Read FAfterDelete Write FAfterDelete;
+    // From TCustomHTTPDataContentProducer
+    Property BeforeUpdate;
+    Property BeforeInsert;
+    Property BeforeDelete;
   end;
 
 implementation
@@ -337,9 +350,12 @@ begin
     ACount:=PageSize;
     While (not DS.EOF) and ((PageSize=0) or (ACount>0)) do
       begin
-      Inc(RCount);
-      Dec(ACount);
-      Rows.Add(RowToJSON);
+      If AllowRow(DS) then
+        begin
+        Inc(RCount);
+        Dec(ACount);
+        Rows.Add(RowToJSON);
+        end;
       DS.Next;
       end;
     If (PageSize>0) then
@@ -411,6 +427,13 @@ begin
   end;
 end;
 
+function TExtJSJSONDataFormatter.AllowRow(ADataset: TDataset): Boolean;
+begin
+  Result:=True;
+  If Assigned(FOnAllowRow) then
+    FOnAllowRow(Self,Dataset,Result);
+end;
+
 procedure TExtJSJSONDataFormatter.StartBatch(ResponseContent: TStream);
 begin
   If Assigned(FBatchResult) then
diff --git a/packages/fcl-web/src/webdata/fpwebdata.pp b/packages/fcl-web/src/webdata/fpwebdata.pp
index ea47199a9a..68c3591e61 100644
--- a/packages/fcl-web/src/webdata/fpwebdata.pp
+++ b/packages/fcl-web/src/webdata/fpwebdata.pp
@@ -132,6 +132,9 @@ type
   TCustomHTTPDataContentProducer = Class(THTTPContentProducer)
   Private
     FAllowPageSize: Boolean;
+    FBeforeDelete: TNotifyEvent;
+    FBeforeInsert: TNotifyEvent;
+    FBeforeUpdate: TNotifyEvent;
     FDataProvider: TFPCustomWebDataProvider;
     FMetadata: Boolean;
     FOnTranscode: TOnTranscodeEvent;
@@ -159,6 +162,12 @@ type
     Procedure DoExceptionToStream(E : Exception; ResponseContent : TStream); virtual; abstract;
     procedure Notification(AComponent: TComponent; Operation: TOperation);override;
     Property Dataset: TDataset Read GetDataSet;
+    // Before a record is about to be updated
+    Property BeforeUpdate : TNotifyEvent Read FBeforeUpdate Write FBeforeUpdate;
+    // Before a record is about to be inserted
+    Property BeforeInsert : TNotifyEvent Read FBeforeInsert Write FBeforeInsert;
+    // Before a record is about to be deleted
+    Property BeforeDelete : TNotifyEvent Read FBeforeDelete Write FBeforeDelete;
   Public
     Constructor Create(AOwner : TComponent); override;
     Property Adaptor : TCustomWebDataInputAdaptor Read FAdaptor Write SetAdaptor;
@@ -464,6 +473,7 @@ type
 
   TFPWebProviderDataModule = Class(TFPCustomWebProviderDataModule)
   Published
+    Property CreateSession;
     Property InputAdaptor;
     Property ContentProducer;
     Property UseProviderManager;
@@ -975,17 +985,23 @@ end;
 procedure TCustomHTTPDataContentProducer.DoUpdateRecord(ResponseContent: TStream);
 begin
   {$ifdef wmdebug}SendDebug('DoUpdateRecord: Updating record');{$endif}
+  If Assigned(FBeforeUpdate) then
+    FBeforeUpdate(Self);
   Provider.Update;
   {$ifdef wmdebug}SendDebug('DoUpdateRecord: Updated record');{$endif}
 end;
 
 procedure TCustomHTTPDataContentProducer.DoInsertRecord(ResponseContent: TStream);
 begin
+  If Assigned(FBeforeInsert) then
+    FBeforeInsert(Self);
   Provider.Insert;
 end;
 
 procedure TCustomHTTPDataContentProducer.DoDeleteRecord(ResponseContent: TStream);
 begin
+  If Assigned(FBeforeDelete) then
+    FBeforeDelete(Self);
   Provider.Delete;
 end;
 
@@ -1663,6 +1679,7 @@ begin
       Exit;
       end;
     end;
+  P:=Nil;
   C:=FindComponent(AProviderName);
   {$ifdef wmdebug}SendDebug(Format('Searching provider "%s" 1 : %d ',[AProvidername,Ord(Assigned(C))]));{$endif}
   If (C<>Nil) and (C is TFPCustomWebDataProvider) then
@@ -1675,7 +1692,9 @@ begin
       begin
       {$ifdef wmdebug}SendDebug(Format('Found providerdef "%s" 1 : %d ',[AProvidername,Ord(Assigned(C))]));{$endif}
       P:=WebDataProviderManager.GetProvider(ADef,Self,AContainer);
-      end;
+      end
+    else
+      P:=Nil;
     end;
   {$ifdef wmdebug}SendDebug(Format('Searching provider "%s" 2 : %d ',[AProvidername,Ord(Assigned(C))]));{$endif}
   Result:=P;
diff --git a/packages/fcl-web/src/webdata/sqldbwebdata.pp b/packages/fcl-web/src/webdata/sqldbwebdata.pp
index 33b1d7f8e1..28b5356045 100644
--- a/packages/fcl-web/src/webdata/sqldbwebdata.pp
+++ b/packages/fcl-web/src/webdata/sqldbwebdata.pp
@@ -17,6 +17,7 @@ Type
   TCustomSQLDBWebDataProvider = Class(TFPCustomWebDataProvider)
   private
     FIDFieldName: String;
+    FONGetDataset: TNotifyEvent;
     FOnGetNewID: TNewIDEvent;
     FOnGetParamValue: TGetParamValueEvent;
     FParams: TParams;
@@ -44,6 +45,7 @@ Type
     Procedure DoApplyParams; override;
     Function SQLQuery : TSQLQuery;
     Function GetDataset : TDataset; override;
+    Function DoGetNewID : String; virtual;
     Function GetNewID : String;
     Function IDFieldValue : String; override;
     procedure Notification(AComponent: TComponent;  Operation: TOperation); override;
@@ -55,6 +57,7 @@ Type
     Property OnGetNewID : TNewIDEvent Read FOnGetNewID Write FOnGetNewID;
     property OnGetParameterType : TGetParamTypeEvent Read FOnGetParamType Write FOnGetParamType;
     property OnGetParameterValue : TGetParamValueEvent Read FOnGetParamValue Write FOnGetParamValue;
+    Property OnGetDataset : TNotifyEvent Read FONGetDataset Write FOnGetDataset;
     Property Params : TParams Read FParams Write SetParams;
   Public
     Constructor Create(AOwner : TComponent); override;
@@ -72,6 +75,7 @@ Type
     Property OnGetNewID;
     property OnGetParameterType;
     property OnGetParameterValue;
+    Property OnGetDataset;
     Property Options;
     Property Params;
   end;
@@ -273,7 +277,12 @@ Var
 
 begin
   ft:=GetParamtype(P,AValue);
-  If ft<>ftUnknown then
+  If (AValue='') and (not (ft in [ftString,ftFixedChar,ftWideString,ftFixedWideChar])) then
+    begin
+    P.Clear;
+    exit;
+    end;
+  If (ft<>ftUnknown) then
     begin
     try
       case ft of
@@ -358,7 +367,10 @@ begin
     if not B then
       begin
       If (P.Name=IDFieldName) and DoNewID then
-        SetTypedParam(P,GetNewID)
+        begin
+        GetNewID;
+        SetTypedParam(P,FLastNewID)
+        end
       else If Adaptor.TryFieldValue(P.Name,S) then
         SetTypedParam(P,S)
       else If Adaptor.TryParamValue(P.Name,S) then
@@ -385,6 +397,8 @@ end;
 function TCustomSQLDBWebDataProvider.GetDataset: TDataset;
 begin
 {$ifdef wmdebug}SendDebug('Get dataset: checking dataset');{$endif}
+  If Assigned(FonGetDataset) then
+    FOnGetDataset(Self);
   CheckDataset;
   FLastNewID:='';
   Result:=FQuery;
@@ -394,12 +408,17 @@ begin
 {$ifdef wmdebug}SendDebug('Get dataset: done');{$endif}
 end;
 
-function TCustomSQLDBWebDataProvider.GetNewID: String;
-
+function TCustomSQLDBWebDataProvider.DoGetNewID: String;
 begin
   If Not Assigned(FOnGetNewID) then
     Raise EFPHTTPError.CreateFmt(SErrNoNewIDEvent,[Self.Name]);
   FOnGetNewID(Self,Result);
+end;
+
+function TCustomSQLDBWebDataProvider.GetNewID: String;
+
+begin
+  Result:=DoGetNewID;
   FLastNewID:=Result;
 end;