--- Merging r16077 into '.':

U    packages/fcl-web/examples/webdata/demo3/extgrid.lpi
U    packages/fcl-web/examples/webdata/demo4/extgrid.lpi
U    packages/fcl-web/examples/webdata/demo5/extgrid.lpi
U    packages/fcl-web/examples/webdata/demo6/extgrid.lpi
--- Merging r16081 into '.':
D    packages/fcl-web/fptemplate.txt
A    packages/fcl-base/texts
A    packages/fcl-base/texts/fptemplate.txt
--- Merging r16083 into '.':
A    packages/fcl-web/src/webdata/readme.txt
D    packages/fcl-web/src/webdata/webdata.txt
--- Merging r16084 into '.':
U    packages/fcl-base/texts/fptemplate.txt
--- Merging r16085 into '.':
U    packages/fcl-web/src/base/README.txt
--- Merging r16095 into '.':
G    packages/fcl-base/texts/fptemplate.txt
--- Merging r16158 into '.':
U    packages/fcl-web/src/jsonrpc/fpjsonrpc.pp
--- Merging r16220 into '.':
U    packages/fcl-web/src/webdata/fpwebdata.pp
--- Merging r16231 into '.':
U    packages/fcl-web/src/webdata/extjsjson.pp
G    packages/fcl-web/src/webdata/fpwebdata.pp
--- Merging r16232 into '.':
U    packages/fcl-web/src/base/custfcgi.pp
--- Merging r16325 into '.':
A    packages/fcl-web/Makefile_fpmake.fpc

# revisions: 16077,16081,16083,16084,16085,16095,16158,16220,16231,16232,16325
------------------------------------------------------------------------
r16077 | michael | 2010-10-04 09:24:28 +0200 (Mon, 04 Oct 2010) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/examples/webdata/demo3/extgrid.lpi
   M /trunk/packages/fcl-web/examples/webdata/demo4/extgrid.lpi
   M /trunk/packages/fcl-web/examples/webdata/demo5/extgrid.lpi
   M /trunk/packages/fcl-web/examples/webdata/demo6/extgrid.lpi

* Renamed lazwebdata to lazwebextra
------------------------------------------------------------------------
------------------------------------------------------------------------
r16081 | michael | 2010-10-05 14:06:33 +0200 (Tue, 05 Oct 2010) | 1 line
Changed paths:
   A /trunk/packages/fcl-base/texts
   A /trunk/packages/fcl-base/texts/fptemplate.txt (from /trunk/packages/fcl-web/fptemplate.txt:16030)
   D /trunk/packages/fcl-web/fptemplate.txt

* Moved description of fptemplate to fcl-base
------------------------------------------------------------------------
------------------------------------------------------------------------
r16083 | michael | 2010-10-05 14:10:03 +0200 (Tue, 05 Oct 2010) | 1 line
Changed paths:
   A /trunk/packages/fcl-web/src/webdata/readme.txt (from /trunk/packages/fcl-web/src/webdata/webdata.txt:16030)
   D /trunk/packages/fcl-web/src/webdata/webdata.txt

* Renamed to be more in line with other readme files
------------------------------------------------------------------------
------------------------------------------------------------------------
r16084 | michael | 2010-10-05 14:12:11 +0200 (Tue, 05 Oct 2010) | 1 line
Changed paths:
   M /trunk/packages/fcl-base/texts/fptemplate.txt

* Corrected references to examples (they are in the lazarus package)
------------------------------------------------------------------------
------------------------------------------------------------------------
r16085 | michael | 2010-10-05 14:15:54 +0200 (Tue, 05 Oct 2010) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/README.txt

* Added reference to fptemplate (saying it is moved to fcl-base)
------------------------------------------------------------------------
------------------------------------------------------------------------
r16095 | michael | 2010-10-07 09:46:11 +0200 (Thu, 07 Oct 2010) | 1 line
Changed paths:
   M /trunk/packages/fcl-base/texts/fptemplate.txt

* Fixed typo
------------------------------------------------------------------------
------------------------------------------------------------------------
r16158 | michael | 2010-10-14 11:57:57 +0200 (Thu, 14 Oct 2010) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/jsonrpc/fpjsonrpc.pp

* Implement GetDisplayName and add ParamByName() implementation.
------------------------------------------------------------------------
------------------------------------------------------------------------
r16220 | michael | 2010-10-25 17:06:27 +0200 (Mon, 25 Oct 2010) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/webdata/fpwebdata.pp

* Reset adaptor - in case of pooled module, same adaptor is is used for each request
------------------------------------------------------------------------
------------------------------------------------------------------------
r16231 | michael | 2010-10-27 14:10:49 +0200 (Wed, 27 Oct 2010) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/webdata/extjsjson.pp
   M /trunk/packages/fcl-web/src/webdata/fpwebdata.pp

* Fixed batch processing, and multiple requests through 1 instance of an Adaptor
------------------------------------------------------------------------
------------------------------------------------------------------------
r16232 | michael | 2010-10-27 14:11:57 +0200 (Wed, 27 Oct 2010) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/custfcgi.pp

* Fixed sending/receiving of large data packets (size >word)
------------------------------------------------------------------------
------------------------------------------------------------------------
r16325 | joost | 2010-11-11 11:33:47 +0100 (Thu, 11 Nov 2010) | 1 line
Changed paths:
   A /trunk/packages/fcl-web/Makefile_fpmake.fpc

 * Added Makefile.fpc which uses fpmake
------------------------------------------------------------------------

git-svn-id: branches/fixes_2_4@16419 -

.gitattributes

@@ -1161,6 +1161,7 @@ packages/fcl-base/src/win/fclel.res -text
 packages/fcl-base/src/win/fileinfo.pp svneol=native#text/plain
 packages/fcl-base/src/wince/fileinfo.pp svneol=native#text/plain
 packages/fcl-base/src/wtex.pp svneol=native#text/plain
+packages/fcl-base/texts/fptemplate.txt svneol=native#text/plain
 packages/fcl-db/Makefile svneol=native#text/plain
 packages/fcl-db/Makefile.fpc svneol=native#text/plain
 packages/fcl-db/fpmake.pp svneol=native#text/plain
@@ -1648,6 +1649,7 @@ packages/fcl-res/xml/versiontypes.xml svneol=native#text/plain
 packages/fcl-res/xml/winpeimagereader.xml svneol=native#text/plain
 packages/fcl-web/Makefile svneol=native#text/plain
 packages/fcl-web/Makefile.fpc svneol=native#text/plain
+packages/fcl-web/Makefile_fpmake.fpc svneol=native#text/plain
 packages/fcl-web/examples/jsonrpc/demo1/README.txt svneol=native#text/plain
 packages/fcl-web/examples/jsonrpc/demo1/demo.lpi svneol=native#text/plain
 packages/fcl-web/examples/jsonrpc/demo1/demo.lpr svneol=native#text/plain
@@ -1737,7 +1739,6 @@ packages/fcl-web/examples/webdata/demo6/wmusers.pp svneol=native#text/plain
 packages/fcl-web/examples/webdata/demos.txt svneol=native#text/plain
 packages/fcl-web/examples/webdata/users.dbf -text
 packages/fcl-web/fpmake.pp svneol=native#text/plain
-packages/fcl-web/fptemplate.txt svneol=native#text/plain
 packages/fcl-web/src/base/Makefile svneol=native#text/plain
 packages/fcl-web/src/base/Makefile.fpc svneol=native#text/plain
 packages/fcl-web/src/base/README.txt svneol=native#text/plain
@@ -1770,8 +1771,8 @@ packages/fcl-web/src/webdata/extjsjson.pp svneol=native#text/plain
 packages/fcl-web/src/webdata/extjsxml.pp svneol=native#text/plain
 packages/fcl-web/src/webdata/fpextjs.pp svneol=native#text/plain
 packages/fcl-web/src/webdata/fpwebdata.pp svneol=native#text/plain
+packages/fcl-web/src/webdata/readme.txt svneol=native#text/plain
 packages/fcl-web/src/webdata/sqldbwebdata.pp svneol=native#text/plain
-packages/fcl-web/src/webdata/webdata.txt svneol=native#text/plain
 packages/fcl-web/tests/cgigateway.lpi svneol=native#text/plain
 packages/fcl-web/tests/cgigateway.pp svneol=native#text/plain
 packages/fcl-web/tests/testcgiapp.lpi svneol=native#text/plain

packages/fcl-web/fptemplate.txt → packages/fcl-base/texts/fptemplate.txt

@@ -1,3 +1,7 @@
+REMARK:
+
+fptemplate.pp has been moved to fcl-base.
+
 fptemplate.pp
 
 implements template support
@@ -33,7 +37,7 @@ define these parameters.
 Some examples for tags with these above, StartDelimiter:='{+' and 
 EndDelimiter:='+}' 
 (the default '{' and '}' is not good when processing HTML templates with 
-JavaSript in them):
+JavaScript in them):
 
 {+ATagHere+}  //Tag name: ATagHere
 
@@ -238,7 +242,7 @@ begin//HTML template tag handling for an html template file
   end;
 end;
 
-full example code at /packages/fcl-web/fptemplate-examples/listrecords/
+full example code at /lazarus/components/fpweb/demo/fptemplate/listrecords/
 ===============================================================================
 
 Step by Step:
@@ -298,7 +302,7 @@ ex: http://localhost/myapache/func1call?param1=paramvalue1
 12. See "Hello World!" in your browser
 13. Repeat from step 4 for other web actions
 
-full example code at /packages/fcl-web/fptemplate-examples/helloworld/
+full example code at /lazarus/components/fpweb/demo/fptemplate/helloworld/
 ===============================================================================
 
 II. Using templates:
@@ -352,7 +356,7 @@ end;
 
 This is a replaced template tag: Here I am from the web module!
 
-full example code at /packages/fcl-web/fptemplate-examples/simpletemplate/
+full example code at /lazarus/components/fpweb/demo/fptemplate/simpletemplate/
 ===============================================================================
 
 III. More complicated HTML template design notes:
@@ -423,5 +427,5 @@ apache module code, therefore no recompiling or apache restart is needed. The
 best way is to make the project such, that the web/html design is separated 
 from the back end apache module as much as possible.
 
-full example code at /packages/fcl-web/fptemplate-examples/tagparam/
+full example code at /lazarus/components/fpweb/demo/fptemplate/tagparam/
 ===============================================================================

packages/fcl-web/Makefile_fpmake.fpc

@@ -0,0 +1,35 @@
+#
+#   Makefile.fpc for TDataSet for FCL
+#
+
+[package]
+name=fcl-web
+version=2.5.1
+
+[require]
+packages=rtl fcl-base fcl-xml fcl-db fcl-json fcl-net fcl-process fastcgi httpd22
+
+[default]
+fpcdir=../..
+
+[prerules]
+# If no fpmake exists and clean is called, do not try to build fpmake, it will
+# most often fail because the dependencies are cleared. So simply skip the
+# clean by replacing the command with 'echo'
+FPMAKE_BIN_CLEAN=$(wildcard ./fpmake$(SRCEXEEXT))
+ifeq ($(FPMAKE_BIN_CLEAN),)
+FPMAKE_BIN_CLEAN=$(ECHO)
+endif
+
+
+[rules]
+fpmake: fpmake.pp
+	$(FPC) fpmake.pp -Fu../fpmkunit/src -dNO_UNIT_PROCESS -dNO_UNIT_ZIPPER $(FPCOPT)
+all:	fpmake
+	./fpmake build --localunitdir=../.. --globalunitdir=.. $(addprefix -o ,$(FPCOPT)) --compiler=$(FPC)
+clean:	
+	$(FPMAKE_BIN_CLEAN) clean --localunitdir=../.. --globalunitdir=.. $(addprefix -o ,$(FPCOPT)) --compiler=$(FPC)
+install:	fpmake
+	./fpmake install --localunitdir=../.. --globalunitdir=.. $(addprefix -o ,$(FPCOPT)) --compiler=$(FPC) --prefix=$(PREFIX)
+	
+

packages/fcl-web/examples/webdata/demo3/extgrid.lpi

@@ -34,7 +34,7 @@
         <MinVersion Minor="1" Release="1" Valid="True"/>
       </Item1>
       <Item2>
-        <PackageName Value="lazwebdata"/>
+        <PackageName Value="lazwebextra"/>
         <MinVersion Valid="True"/>
       </Item2>
       <Item3>
@@ -98,8 +98,8 @@
         <SyntaxHighlighter Value="LFM"/>
       </Unit4>
       <Unit5>
-        <Filename Value="../demo/reglazwebdata.pp"/>
-        <UnitName Value="reglazwebdata"/>
+        <Filename Value="../demo/reglazwebextra.pp"/>
+        <UnitName Value="reglazwebextra"/>
         <CursorPos X="53" Y="50"/>
         <TopLine Value="34"/>
         <EditorIndex Value="0"/>

packages/fcl-web/examples/webdata/demo4/extgrid.lpi

@@ -36,7 +36,7 @@
         <MinVersion Minor="1" Release="1" Valid="True"/>
       </Item1>
       <Item2>
-        <PackageName Value="lazwebdata"/>
+        <PackageName Value="lazwebextra"/>
         <MinVersion Valid="True"/>
       </Item2>
       <Item3>

packages/fcl-web/examples/webdata/demo5/extgrid.lpi

@@ -32,7 +32,7 @@
     </RunParams>
     <RequiredPackages Count="4">
       <Item1>
-        <PackageName Value="lazwebdata"/>
+        <PackageName Value="lazwebextra"/>
         <MinVersion Valid="True"/>
       </Item1>
       <Item2>

packages/fcl-web/examples/webdata/demo6/extgrid.lpi

@@ -35,7 +35,7 @@
         <MinVersion Major="1" Release="1" Valid="True"/>
       </Item1>
       <Item2>
-        <PackageName Value="lazwebdata"/>
+        <PackageName Value="lazwebextra"/>
         <MinVersion Valid="True"/>
       </Item2>
       <Item3>
@@ -201,8 +201,8 @@
         <Loaded Value="True"/>
       </Unit14>
       <Unit15>
-        <Filename Value="../demo/reglazwebdata.pp"/>
-        <UnitName Value="reglazwebdata"/>
+        <Filename Value="../demo/reglazwebextra.pp"/>
+        <UnitName Value="reglazwebextra"/>
         <EditorIndex Value="9"/>
         <WindowIndex Value="0"/>
         <TopLine Value="37"/>
@@ -281,7 +281,7 @@
         <Caret Line="58" Column="1" TopLine="22"/>
       </Position17>
       <Position18>
-        <Filename Value="../demo/reglazwebdata.pp"/>
+        <Filename Value="../demo/reglazwebextra.pp"/>
         <Caret Line="17" Column="15" TopLine="1"/>
       </Position18>
       <Position19>

packages/fcl-web/src/base/README.txt

@@ -1,6 +1,9 @@
 This is the beginning of a server side web system for FPC.
 Although it is non-visual, it is geared towards use in Lazarus.
 
+NOTE: the template support (fptemplate unit) was moved to 
+fcl-base. See the fcl-base/texts/fptemplate.txt file.
+
 Architecture:
 
 httpdefs

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

@@ -306,12 +306,19 @@ end;
 
 { TCGIResponse }
 procedure TFCGIResponse.Write_FCGIRecord(ARecord : PFCGI_Header);
-var BytesToWrite : word;
+
+var BytesToWrite : Integer;
     BytesWritten  : Integer;
+    P : PByte;
 begin
   BytesToWrite := BEtoN(ARecord^.contentLength) + ARecord^.paddingLength+sizeof(FCGI_Header);
-  BytesWritten := sockets.fpsend(TFCGIRequest(Request).Handle, ARecord, BytesToWrite, NoSignalAttr);
-  Assert(BytesWritten=BytesToWrite);
+  P:=PByte(Arecord);
+  Repeat
+    BytesWritten := sockets.fpsend(TFCGIRequest(Request).Handle, P, BytesToWrite, NoSignalAttr);
+    Inc(P,BytesWritten);
+    Dec(BytesToWrite,BytesWritten);
+//    Assert(BytesWritten=BytesToWrite);
+  until (BytesToWrite=0) or (BytesWritten=0);
 end;
 
 procedure TFCGIResponse.DoSendHeaders(Headers : TStrings);
@@ -351,7 +358,12 @@ begin
 end;
 
 procedure TFCGIResponse.DoSendContent;
+
+Const
+  MaxBuf = $EFFF;
+
 var
+  bs,l : Integer;
   cl : word;
   pl : byte;
   str : String;
@@ -367,24 +379,30 @@ begin
     end
   else
     str := Contents.Text;
-  cl := length(str);
-  if ((cl mod 8)=0) or (poNoPadding in ProtocolOptions) then
-    pl:=0
-  else
-    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[1],ARespRecord^.ContentData,cl);
-
-  Write_FCGIRecord(PFCGI_Header(ARespRecord));
-  Freemem(ARespRecord);
+  L:=Length(Str);
+  BS:=0;
+  Repeat
+    If (L-BS)>MaxBuf then
+      cl := MaxBuf
+    else
+      cl:=L-BS ;
+    if ((cl mod 8)=0) or (poNoPadding in ProtocolOptions) then
+      pl:=0
+    else
+      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);
+    Inc(BS,cl);
+  Until (BS=L);
   FillChar(EndRequest,SizeOf(FCGI_EndRequestRecord),0);
-
   EndRequest.header.version:=FCGI_VERSION_1;
   EndRequest.header.reqtype:=FCGI_END_REQUEST;
   EndRequest.header.contentLength:=NtoBE(8);

packages/fcl-web/src/jsonrpc/fpjsonrpc.pp

@@ -22,6 +22,8 @@ Type
     FRequired: Boolean;
     FType: TJSONtype;
     procedure SetName(const AValue: TJSONStringType);
+  protected
+    function GetDisplayName: string; override;
   public
     Constructor Create(ACollection : TCollection); override;
     Procedure Assign(Source : TPersistent); override;
@@ -59,6 +61,7 @@ Type
     FOnParamError: TJSONParamErrorEvent;
     FOptions: TJSONRPCOptions;
     FParamDefs: TJSONParamDefs;
+    FExecParams : TJSONData;
     procedure SetParamDefs(const AValue: TJSONParamDefs);
   Protected
     function CreateParamDefs: TJSONParamDefs; virtual;
@@ -72,6 +75,7 @@ Type
     Constructor Create(AOwner : TComponent); override;
     Destructor Destroy; override;
     Procedure CheckParams(Const Params : TJSONData);
+    Function ParamByName(Const AName : String) : TJSONData;
     Function Execute(Const Params : TJSONData; AContext : TJSONRPCCallContext = Nil) : TJSONData;
     Property ParamDefs : TJSONParamDefs Read FParamDefs Write SetParamDefs;
   end;
@@ -433,6 +437,13 @@ begin
   FName:=AValue;
 end;
 
+function TJSONParamDef.GetDisplayName: string;
+begin
+  Result:=FName;
+  If (Result='') then
+    Result:=Inherited GetDisplayName;
+end;
+
 constructor TJSONParamDef.Create(ACollection: TCollection);
 begin
   inherited Create(ACollection);
@@ -531,6 +542,33 @@ begin
   end;
 end;
 
+function TCustomJSONRPCHandler.ParamByName(const AName: String): TJSONData;
+
+Var
+  I : Integer;
+  N : String;
+
+begin
+  If (FExecParams=Nil) or Not (FExecParams.JSONType in [jtArray,jtObject]) then
+    Result:=Nil
+  else
+    begin
+    I:=ParamDefs.IndexOfParamDef(AName);
+    If (I=-1) then
+      N:=AName
+    else
+      N:=ParamDefs[i].Name; // Search with original defined name.
+    If (FExecParams is TJSONObject) then
+      Result:=TJSONObject(FExecParams).Elements[N]
+    else if (FExecParams is TJSONArray) then
+      begin
+      If (I=-1) or (I>=FExecParams.Count) then
+        JSONRPCError(SErrUnknownParamDef,[AName]);
+      Result:=TJSONArray(FExecParams).Items[i];
+      end;
+    end;
+end;
+
 procedure TCustomJSONRPCHandler.SetParamDefs(const AValue: TJSONParamDefs);
 begin
   if FParamDefs=AValue then exit;
@@ -574,7 +612,12 @@ begin
     FBeforeExecute(Self);
   if (jroCheckParams in Options) then
     CheckParams(Params);
-  Result:=DoExecute(Params,AContext);
+  FExecParams:=Params;
+  try
+    Result:=DoExecute(Params,AContext);
+  finally
+    FExecParams:=Nil;
+  end;
   If Assigned(FAfterExecute) then
     FAfterExecute(Self);
 end;

packages/fcl-web/src/webdata/extjsjson.pp

@@ -19,6 +19,7 @@ type
     FRowIndex : integer;
     function CheckData: Boolean;
   Public
+    procedure reset; override;
     Function GetNextBatch : Boolean; override;
     Function TryFieldValue(Const AFieldName : String; out AValue : String) : Boolean; override;
     Destructor destroy; override;
@@ -39,8 +40,13 @@ type
     FBeforeRowToJSON: TJSONObjectEvent;
     FOnErrorResponse: TJSONExceptionObjectEvent;
     FOnMetaDataToJSON: TJSONObjectEvent;
-    procedure SendSuccess(ResponseContent: TStream; AddIDValue : Boolean = False; CallBack : TJSONObjectEvent = Nil);
+    FBatchResult : TJSONArray;
+    Function AddIdToBatch : TJSONObject;
+    procedure SendSuccess(ResponseContent: TStream; AddIDValue : Boolean = False);
   protected
+    Procedure StartBatch(ResponseContent : TStream); override;
+    Procedure NextBatchItem(ResponseContent : TStream); override;
+    Procedure EndBatch(ResponseContent : TStream); override;
     Function CreateAdaptor(ARequest : TRequest) : TCustomWebdataInputAdaptor; override;
     Function AddFieldToJSON(O: TJSONObject; AFieldName: String; F: TField): TJSONData;
     function GetDataContentType: String; override;
@@ -56,6 +62,8 @@ type
     Procedure DoInsertRecord(ResponseContent : TStream); override;
     Procedure DoUpdateRecord(ResponseContent : TStream); override;
     Procedure DoDeleteRecord(ResponseContent : TStream); override;
+  Public
+    Destructor destroy; override;
   Published
     // Called before any fields are added to row object (passed to handler).
     Property AfterRowToJSON : TJSONObjectEvent Read FAfterRowToJSON Write FAfterRowToJSON;
@@ -369,6 +377,7 @@ begin
     L:=Resp.AsJSON;
     If Length(L)>0 then
       ResponseContent.WriteBuffer(L[1],Length(L));
+    Resp.Add('root',RowsProperty);
     Resp.Add(RowsProperty,TJSONArray.Create());
     If Assigned(FOnErrorResponse) then
       FOnErrorResponse(Self,E,Resp);
@@ -377,7 +386,7 @@ begin
   end;
 end;
 
-procedure TExtJSJSONDataFormatter.SendSuccess(ResponseContent: TStream; AddIDValue : Boolean = False; CallBack : TJSONObjectEvent = Nil);
+procedure TExtJSJSONDataFormatter.SendSuccess(ResponseContent: TStream; AddIDValue : Boolean = False);
 
 Var
    Resp : TJSonObject;
@@ -387,9 +396,14 @@ begin
   try
     Resp:=TJsonObject.Create;
     Resp.Add(SuccessProperty,True);
-    Resp.Add(Provider.IDFieldName,Provider.IDFieldValue);
-    If Assigned(CallBack) then
-      CallBack(Self,Resp);
+    Resp.Add('root',Self.RowsProperty);
+    If Assigned(FBatchResult) and (FBatchResult.Count>0) then
+      begin
+      Resp.Add(Self.RowsProperty,FBatchResult);
+      FBatchResult:=Nil;
+      end
+    else
+      Resp.Add(Self.RowsProperty,TJSONNull.Create());
     L:=Resp.AsJSON;
     ResponseContent.WriteBuffer(L[1],Length(L));
   finally
@@ -397,23 +411,65 @@ begin
   end;
 end;
 
+procedure TExtJSJSONDataFormatter.StartBatch(ResponseContent: TStream);
+begin
+  If Assigned(FBatchResult) then
+    FBatchResult.Clear
+  else
+    FBatchResult:=TJSONArray.Create();
+end;
+
+procedure TExtJSJSONDataFormatter.NextBatchItem(ResponseContent: TStream);
+begin
+end;
+
+procedure TExtJSJSONDataFormatter.EndBatch(ResponseContent: TStream);
+begin
+  SendSuccess(Responsecontent,True);
+end;
+
+Function TExtJSJSONDataFormatter.AddIdToBatch : TJSONObject;
+
+begin
+  Result:=TJSONObject.Create([Provider.IDFieldName,Provider.IDFieldValue]);
+  FBatchResult.Add(Result);
+end;
+
 procedure TExtJSJSONDataFormatter.DoInsertRecord(ResponseContent: TStream);
 
+Var
+  D : TJSONObject;
+
 begin
   Inherited;
-  SendSuccess(ResponseContent,True,FAfterInsert);
+  D:=AddIDToBatch;
+  If Assigned(FAfterInsert) then
+    FAfterInsert(Self,D);
 end;
 
 procedure TExtJSJSONDataFormatter.DoUpdateRecord(ResponseContent: TStream);
+
+Var
+  D : TJSONObject;
+
 begin
   inherited DoUpdateRecord(ResponseContent);
-  SendSuccess(ResponseContent,False,FAfterUpdate);
+  D:=AddIDToBatch;
+  If Assigned(FAfterUpdate) then
+    FAfterUpdate(Self,D);
 end;
 
 procedure TExtJSJSONDataFormatter.DoDeleteRecord(ResponseContent: TStream);
 begin
   inherited DoDeleteRecord(ResponseContent);
-  SendSuccess(ResponseContent,False,FAfterDelete);
+  If Assigned(FAfterDelete) then
+    FAfterDelete(Self,Nil);
+end;
+
+destructor TExtJSJSONDataFormatter.destroy;
+begin
+  FreeAndNil(FBatchResult);
+  inherited destroy;
 end;
 
 { TExtJSJSonWebdataInputAdaptor }
@@ -459,6 +515,17 @@ begin
     end;
 end;
 
+procedure TExtJSJSonWebdataInputAdaptor.reset;
+begin
+  If (FRows=Nil) then
+    FreeAndNil(FCurrentRow)
+  else
+    FreeAndNil(FRows);
+  FRowIndex:=0;
+  FreeAndNil(FIDValue);
+  inherited reset;
+end;
+
 function TExtJSJSonWebdataInputAdaptor.GetNextBatch: Boolean;
 begin
   If (FRows=Nil) then

packages/fcl-web/src/webdata/fpwebdata.pp

@@ -15,6 +15,9 @@ type
   // Descendents must adapt the methods so they fit the particular JS/HTML engine used.
 
   TWebDataAction = (wdaUnknown,wdaRead,wdaUpdate,wdaInsert,wdaDelete);
+
+  { TCustomWebdataInputAdaptor }
+
   TCustomWebdataInputAdaptor = class(TComponent)
   private
     FAction: TWebDataAction;
@@ -24,6 +27,7 @@ type
     function GetAction: TWebDataAction;
     procedure SetRequest(const AValue: TRequest);
   Protected
+    procedure reset; virtual;
     Function GetActionFromRequest : TWebDataAction; virtual;
   Public
     Function GetNextBatch : Boolean; virtual;
@@ -140,6 +144,9 @@ type
     procedure SetAdaptor(const AValue: TCustomWebDataInputAdaptor);
     procedure SetDataProvider(const AValue: TFPCustomWebDataProvider);
   Protected
+    Procedure StartBatch(ResponseContent : TStream); virtual;
+    Procedure NextBatchItem(ResponseContent : TStream); virtual;
+    Procedure EndBatch(ResponseContent : TStream); virtual;
     Function GetDataContentType : String; virtual;
     procedure DatasetToStream(Stream: TStream); virtual;abstract;
     Function CreateAdaptor(ARequest : TRequest) : TCustomWebdataInputAdaptor; virtual;
@@ -518,9 +525,17 @@ Resourcestring
 
 procedure TCustomWebdataInputAdaptor.SetRequest(const AValue: TRequest);
 begin
+  If FRequest=AValue then Exit;
   FRequest:=AValue;
+  Reset;
+end;
+
+procedure TCustomWebdataInputAdaptor.reset;
+begin
+{$ifdef wmdebug}SendDebugFmt('TCustomWebdataInputAdaptor.Reset (%s)',[FRequestPathInfo]);{$endif}
   FBatchCount:=0;
   Faction:=wdaUnknown;
+  FRequestPathInfo:='';
 end;
 
 function TCustomWebdataInputAdaptor.GetActionFromRequest: TWebDataAction;
@@ -535,6 +550,7 @@ begin
     if (FRequestPathInfo='') then
       FRequestPathInfo:=Request.GetNextPathInfo;
     N:=lowercase(FRequestPathInfo);
+{$ifdef wmdebug}SendDebugFmt('TCustomWebdataInputAdaptor.GetActionFromRequest : %s (%s)',[n,Request.Pathinfo]);{$endif}
     If (N='read') then
       Result:=wdaRead
     else If (N='insert') then
@@ -856,6 +872,22 @@ begin
     FDataProvider.FreeNotification(Self);
 end;
 
+procedure TCustomHTTPDataContentProducer.StartBatch(ResponseContent: TStream);
+begin
+  // Do nothing
+end;
+
+procedure TCustomHTTPDataContentProducer.NextBatchItem(ResponseContent: TStream
+  );
+begin
+  // do nothing
+end;
+
+procedure TCustomHTTPDataContentProducer.EndBatch(ResponseContent: TStream);
+begin
+  // do nothing
+end;
+
 function TCustomHTTPDataContentProducer.GetDataContentType: String;
 begin
   Result:='';
@@ -875,6 +907,7 @@ Var
   A : TCustomWebdataInputAdaptor;
 
 begin
+  {$ifdef wmdebug}SendDebugFmt('Request content %s',[ARequest.Content]);{$endif}
   B:=(Adaptor=Nil);
   if B then
     begin
@@ -883,35 +916,43 @@ begin
     end;
   try
     try
-      While Adaptor.GetNextBatch do
-        begin
-        {$ifdef wmdebug}SendDebug('Starting batch Loop');{$endif}
-        Case Adaptor.Action of
-          wdaInsert : DoInsertRecord(Content);
-          wdaUpdate : begin
-                      {$ifdef wmdebug}SendDebug('Aha1');{$endif}
-                      DoUpdateRecord(Content);
-                      {$ifdef wmdebug}SendDebug('Aha2');{$endif}
-                      end;
-          wdaDelete : DoDeleteRecord(Content);
-          wdaRead   : DoReadRecords(Content);
-        else
-          inherited DoGetContent(ARequest, Content,Handled);
-        end;
-        if (Adaptor.Action in [wdaInsert,wdaUpdate,wdaDelete,wdaRead]) then
-          Handled:=true;
+      Case Adaptor.Action of
+        wdaRead : DoReadRecords(Content);
+        wdaInsert,
+        wdaUpdate,
+        wdaDelete :
+          begin
+          {$ifdef wmdebug}SendDebug('Starting batch Loop');{$endif}
+          StartBatch(Content);
+          While Adaptor.GetNextBatch do
+            begin
+            {$ifdef wmdebug}SendDebug('Next batch item');{$endif}
+            NextBatchItem(Content);
+            Case Adaptor.Action of
+              wdaInsert  : DoInsertRecord(Content);
+              wdaUpdate  : DoUpdateRecord(Content);
+              wdaDelete  : DoDeleteRecord(Content);
+            else
+              inherited DoGetContent(ARequest, Content,Handled);
+            end;
+          end;
+         EndBatch(Content);
         {$ifdef wmdebug}SendDebug('Ended batch Loop');{$endif}
-        end;
-    except
-    On E : Exception do
-      begin
-      DoExceptionToStream(E,Content);
-      Handled:=True;
+         end;
+      else
+        Raise EFPHTTPError.Create(SErrNoAction);
       end;
+      Handled:=true;
+    except
+      On E : Exception do
+        begin
+        DoExceptionToStream(E,Content);
+        Handled:=True;
+        end;
     end;
   finally
     If B then
-     FreeAndNil(A);
+      FreeAndNil(A);
   end;
 end;
 
@@ -1667,6 +1708,7 @@ begin
     try
       A:=GetAdaptor;
       A.Request:=ARequest;
+      A.Reset; // Force. for wmKind=pooled, fastcgi, request can be the same.
       Wa:=A.GetAction;
       Case WA of
         wdaUnknown : Raise EFPHTTPError.CreateFmt(SErrUnknownProviderAction,[ProviderName]);