--- Merging r15616 into '.':

U    packages/fcl-web/src/base/custcgi.pp
U    packages/fcl-web/src/base/fpweb.pp
U    packages/fcl-web/src/base/fphttp.pp
U    packages/fcl-web/src/base/custfcgi.pp
U    packages/fcl-web/src/base/webpage.pp
U    packages/fcl-web/src/base/websession.pp
U    packages/fcl-web/src/base/httpdefs.pp
U    packages/fcl-web/src/base/fphtml.pp
--- Merging r15617 into '.':
G    packages/fcl-web/src/base/custcgi.pp
G    packages/fcl-web/src/base/fpweb.pp
G    packages/fcl-web/src/base/fphttp.pp
G    packages/fcl-web/src/base/webpage.pp
G    packages/fcl-web/src/base/websession.pp
G    packages/fcl-web/src/base/httpdefs.pp
G    packages/fcl-web/src/base/fphtml.pp
--- Merging r15621 into '.':
U    packages/fcl-web/src/base/custcgi.pp
G    packages/fcl-web/src/base/custfcgi.pp
U    packages/fcl-web/src/base/fpapache.pp
U    packages/fcl-web/src/base/fcgigate.pp
U    packages/fcl-web/src/base/custweb.pp
--- Merging r15622 into '.':
G    packages/fcl-web/src/base/fpapache.pp
U    packages/fcl-web/src/base/fpcgi.pp
U    packages/fcl-web/src/base/fpfcgi.pp
--- Merging r15665 into '.':
U    packages/fcl-extra/src/daemonapp.pp
G    packages/fcl-web/src/base/custweb.pp
U    packages/fcl-base/src/custapp.pp
--- Merging r15667 into '.':
U    packages/fcl-web/src/jsonrpc/Makefile.fpc
C    packages/fcl-web/src/jsonrpc/Makefile
--- Merging r15668 into '.':
U    packages/fcl-web/src/jsonrpc/fpjsonrpc.pp
--- Merging r15669 into '.':
U    packages/fcl-web/src/jsonrpc/fpextdirect.pp
--- Merging r15670 into '.':
U    packages/fcl-base/src/unix/eventlog.inc
U    packages/fcl-base/src/eventlog.pp
U    packages/fcl-base/src/dummy/eventlog.inc
U    packages/fcl-base/src/win/eventlog.inc
U    packages/fcl-base/src/os2/eventlog.inc
--- Merging r15686 into '.':
U    packages/fcl-db/src/sqlite/customsqliteds.pas
U    packages/fcl-db/src/sqlite/sqliteds.pas
U    packages/fcl-db/src/sqlite/sqlite3ds.pas
--- Merging r15691 into '.':
U    rtl/win/sysutils.pp
--- Merging r15696 into '.':
G    packages/fcl-web/src/jsonrpc/fpextdirect.pp
--- Merging r15698 into '.':
G    packages/fcl-web/src/base/custweb.pp
--- Merging r15714 into '.':
U    packages/fcl-web/src/webdata/sqldbwebdata.pp
--- Merging r15719 into '.':
U    packages/fcl-web/src/webdata/extjsjson.pp
--- Merging r15720 into '.':
U    packages/fcl-web/src/base/websession.pp
--- Merging r15721 into '.':
G    packages/fcl-web/src/base/websession.pp
--- Merging r15722 into '.':
G    packages/fcl-web/src/base/custfcgi.pp
--- Merging r15763 into '.':
U    compiler/utils/gppc386.pp
 U   compiler/utils
--- Merging r15793 into '.':
U    packages/fpvectorial/Makefile.fpc
A    packages/fpvectorial/src/cdrvectorialreader.pas
A    packages/fpvectorial/src/svgvectorialwriter.pas
A    packages/fpvectorial/examples
A    packages/fpvectorial/examples/cdr2svg_mainform.lfm
A    packages/fpvectorial/examples/cdr2svg_visual.lpi
A    packages/fpvectorial/examples/cdr2svg_mainform.pas
A    packages/fpvectorial/examples/cdr2svg_visual.ico
A    packages/fpvectorial/examples/cdr2svg_visual.lpr
--- Merging r15799 into '.':
U    packages/fpvectorial/src/fpvectorial.pas
U    packages/fpvectorial/src/pdfvrsemantico.pas
U    packages/fpvectorial/src/svgvectorialwriter.pas
U    packages/fpvectorial/src/fpvtocanvas.pas
U    packages/fpvectorial/examples/cdr2svg_mainform.lfm
U    packages/fpvectorial/examples/cdr2svg_visual.lpi
U    packages/fpvectorial/examples/cdr2svg_mainform.pas
U    packages/fpvectorial/examples/cdr2svg_visual.lpr
--- Merging r15800 into '.':
G    packages/fcl-web/src/jsonrpc/fpjsonrpc.pp
--- Merging r15801 into '.':
G    packages/fpvectorial/src/fpvectorial.pas
G    packages/fpvectorial/src/svgvectorialwriter.pas
G    packages/fpvectorial/src/fpvtocanvas.pas
--- Merging r15802 into '.':
G    packages/fpvectorial/examples/cdr2svg_mainform.pas
--- Merging r15804 into '.':
U    rtl/objpas/dateutil.inc
--- Merging r15808 into '.':
U    packages/x11/src/xlib.pp
--- Merging r15815 into '.':
U    packages/fcl-web/examples/webdata/demo/extgrid.lpr
--- Merging r15816 into '.':
U    packages/fcl-web/examples/webdata/demo/wmusers.pp
--- Merging r15817 into '.':
G    packages/fcl-web/examples/webdata/demo/wmusers.pp
--- Merging r15826 into '.':
G    packages/fpvectorial/src/fpvectorial.pas
A    packages/fpvectorial/examples/fpvectorialconverter.ico
A    packages/fpvectorial/examples/fpvectorialconverter.lpr
A    packages/fpvectorial/examples/fpvc_mainform.lfm
A    packages/fpvectorial/examples/fpvc_mainform.pas
A    packages/fpvectorial/examples/fpvectorialconverter.lpi
D    packages/fpvectorial/examples/cdr2svg_visual.ico
D    packages/fpvectorial/examples/cdr2svg_visual.lpr
D    packages/fpvectorial/examples/cdr2svg_mainform.lfm
D    packages/fpvectorial/examples/cdr2svg_visual.lpi
D    packages/fpvectorial/examples/cdr2svg_mainform.pas
--- Merging r15827 into '.':
U    packages/fcl-image/src/freetype.pp
U    packages/fcl-image/src/freetypeh.pp
--- Merging r15829 into '.':
G    packages/fpvectorial/src/fpvectorial.pas
U    packages/fpvectorial/src/cdrvectorialreader.pas
A    packages/fpvectorial/examples/fpce_mainform.lfm
U    packages/fpvectorial/examples/fpvc_mainform.lfm
A    packages/fpvectorial/examples/fpcorelexplorer.ico
A    packages/fpvectorial/examples/fpce_mainform.pas
A    packages/fpvectorial/examples/fpcorelexplorer.lpr
A    packages/fpvectorial/examples/fpcorelexplorer.lpi
Summary of conflicts:
  Text conflicts: 1

# revisions: 15616,15617,15621,15622,15665,15667,15668,15669,15670,15686,15691,15696,15698,15714,15719,15720,15721,15722,15763,15793,15799,15800,15801,15802,15804,15808,15815,15816,15817,15826,15827,15829
------------------------------------------------------------------------
r15616 | joost | 2010-07-20 11:52:22 +0200 (Tue, 20 Jul 2010) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/custcgi.pp
   M /trunk/packages/fcl-web/src/base/custfcgi.pp
   M /trunk/packages/fcl-web/src/base/fphtml.pp
   M /trunk/packages/fcl-web/src/base/fphttp.pp
   M /trunk/packages/fcl-web/src/base/fpweb.pp
   M /trunk/packages/fcl-web/src/base/httpdefs.pp
   M /trunk/packages/fcl-web/src/base/webpage.pp
   M /trunk/packages/fcl-web/src/base/websession.pp

 * Fixed FastCGI listening on a port on Windows after r15099
------------------------------------------------------------------------
------------------------------------------------------------------------
r15617 | joost | 2010-07-20 11:55:42 +0200 (Tue, 20 Jul 2010) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/custcgi.pp
   M /trunk/packages/fcl-web/src/base/fphtml.pp
   M /trunk/packages/fcl-web/src/base/fphttp.pp
   M /trunk/packages/fcl-web/src/base/fpweb.pp
   M /trunk/packages/fcl-web/src/base/httpdefs.pp
   M /trunk/packages/fcl-web/src/base/webpage.pp
   M /trunk/packages/fcl-web/src/base/websession.pp

 * Reverted accidentally committed files in r15616
------------------------------------------------------------------------
------------------------------------------------------------------------
r15621 | joost | 2010-07-21 12:24:01 +0200 (Wed, 21 Jul 2010) | 3 lines
Changed paths:
   M /trunk/packages/fcl-web/src/base/custcgi.pp
   M /trunk/packages/fcl-web/src/base/custfcgi.pp
   M /trunk/packages/fcl-web/src/base/custweb.pp
   M /trunk/packages/fcl-web/src/base/fcgigate.pp
   M /trunk/packages/fcl-web/src/base/fpapache.pp

 * Moved the  handling of web-request from the TCustomWebApplication to a new class
   TWebHandler. TCustomWebApplication and derivates are now a wrapper around the TWebHandler
 * Added TWebHandler.OnIdle event
------------------------------------------------------------------------
------------------------------------------------------------------------
r15622 | joost | 2010-07-21 13:02:45 +0200 (Wed, 21 Jul 2010) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/fpapache.pp
   M /trunk/packages/fcl-web/src/base/fpcgi.pp
   M /trunk/packages/fcl-web/src/base/fpfcgi.pp

 * Set the global CustomApplication variable, usefull for logging
------------------------------------------------------------------------
------------------------------------------------------------------------
r15665 | michael | 2010-07-30 11:26:21 +0200 (Fri, 30 Jul 2010) | 1 line
Changed paths:
   M /trunk/packages/fcl-base/src/custapp.pp
   M /trunk/packages/fcl-extra/src/daemonapp.pp
   M /trunk/packages/fcl-web/src/base/custweb.pp

* Patch from Luiz Americo to use const string params in Log call
------------------------------------------------------------------------
------------------------------------------------------------------------
r15667 | michael | 2010-07-30 12:09:26 +0200 (Fri, 30 Jul 2010) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/jsonrpc/Makefile
   M /trunk/packages/fcl-web/src/jsonrpc/Makefile.fpc

* Dependency op fcl-process voor dbugintf
------------------------------------------------------------------------
------------------------------------------------------------------------
r15668 | michael | 2010-07-30 12:12:33 +0200 (Fri, 30 Jul 2010) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/jsonrpc/fpjsonrpc.pp

* error handling is slightly different in ext.direct. Create virtual method so it can be overridden
------------------------------------------------------------------------
------------------------------------------------------------------------
r15669 | michael | 2010-07-30 12:13:12 +0200 (Fri, 30 Jul 2010) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/jsonrpc/fpextdirect.pp

 Ext.Direct compliant error handling. API now also handles more than one handler. Session handling added
------------------------------------------------------------------------
------------------------------------------------------------------------
r15670 | michael | 2010-07-30 15:36:31 +0200 (Fri, 30 Jul 2010) | 1 line
Changed paths:
   M /trunk/packages/fcl-base/src/dummy/eventlog.inc
   M /trunk/packages/fcl-base/src/eventlog.pp
   M /trunk/packages/fcl-base/src/os2/eventlog.inc
   M /trunk/packages/fcl-base/src/unix/eventlog.inc
   M /trunk/packages/fcl-base/src/win/eventlog.inc

* Patch from Luiz Americo to put Const in front of string parameters
------------------------------------------------------------------------
------------------------------------------------------------------------
r15686 | blikblum | 2010-08-01 16:13:51 +0200 (Sun, 01 Aug 2010) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/sqlite/customsqliteds.pas
   M /trunk/packages/fcl-db/src/sqlite/sqlite3ds.pas
   M /trunk/packages/fcl-db/src/sqlite/sqliteds.pas

* Do not change SQL property value internally. Use instead a separated field (FEffectiveSQL)
------------------------------------------------------------------------
------------------------------------------------------------------------
r15691 | marco | 2010-08-02 22:32:50 +0200 (Mon, 02 Aug 2010) | 1 line
Changed paths:
   M /trunk/rtl/win/sysutils.pp

 * getlocalformatsettings, Mantis 10389
------------------------------------------------------------------------
------------------------------------------------------------------------
r15696 | michael | 2010-08-03 09:57:20 +0200 (Tue, 03 Aug 2010) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/jsonrpc/fpextdirect.pp

* Bugfix for case of more than one handler classname
------------------------------------------------------------------------
------------------------------------------------------------------------
r15698 | michael | 2010-08-03 10:39:55 +0200 (Tue, 03 Aug 2010) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/custweb.pp

* Fixed never-ending CGI scripts
------------------------------------------------------------------------
------------------------------------------------------------------------
r15714 | michael | 2010-08-05 23:47:47 +0200 (Thu, 05 Aug 2010) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/webdata/sqldbwebdata.pp

* Support for design-time parameters
------------------------------------------------------------------------
------------------------------------------------------------------------
r15719 | michael | 2010-08-06 11:04:40 +0200 (Fri, 06 Aug 2010) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/webdata/extjsjson.pp

* Null values should be sent as NULL in json
------------------------------------------------------------------------
------------------------------------------------------------------------
r15720 | michael | 2010-08-06 11:06:44 +0200 (Fri, 06 Aug 2010) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/websession.pp

* Correct check for Session in checksession, and do not create same session cookie twice
------------------------------------------------------------------------
------------------------------------------------------------------------
r15721 | michael | 2010-08-06 11:07:12 +0200 (Fri, 06 Aug 2010) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/websession.pp

* Switch off debug define
------------------------------------------------------------------------
------------------------------------------------------------------------
r15722 | michael | 2010-08-06 11:07:44 +0200 (Fri, 06 Aug 2010) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/custfcgi.pp

* Parse cookies after initializing request variables
------------------------------------------------------------------------
------------------------------------------------------------------------
r15763 | pierre | 2010-08-10 13:37:06 +0200 (Tue, 10 Aug 2010) | 1 line
Changed paths:
   M /trunk/compiler/utils
   M /trunk/compiler/utils/gppc386.pp

 + Always try to find Compiler in same directory first
------------------------------------------------------------------------
------------------------------------------------------------------------
r15793 | sekelsenmat | 2010-08-13 10:24:27 +0200 (Fri, 13 Aug 2010) | 1 line
Changed paths:
   M /trunk/packages/fpvectorial/Makefile.fpc
   A /trunk/packages/fpvectorial/examples
   A /trunk/packages/fpvectorial/examples/cdr2svg_mainform.lfm
   A /trunk/packages/fpvectorial/examples/cdr2svg_mainform.pas
   A /trunk/packages/fpvectorial/examples/cdr2svg_visual.ico
   A /trunk/packages/fpvectorial/examples/cdr2svg_visual.lpi
   A /trunk/packages/fpvectorial/examples/cdr2svg_visual.lpr
   A /trunk/packages/fpvectorial/src/cdrvectorialreader.pas
   A /trunk/packages/fpvectorial/src/svgvectorialwriter.pas

Starts code to add support to cdr and svg to fpvectorial
------------------------------------------------------------------------
------------------------------------------------------------------------
r15799 | sekelsenmat | 2010-08-13 16:56:40 +0200 (Fri, 13 Aug 2010) | 1 line
Changed paths:
   M /trunk/packages/fpvectorial/examples/cdr2svg_mainform.lfm
   M /trunk/packages/fpvectorial/examples/cdr2svg_mainform.pas
   M /trunk/packages/fpvectorial/examples/cdr2svg_visual.lpi
   M /trunk/packages/fpvectorial/examples/cdr2svg_visual.lpr
   M /trunk/packages/fpvectorial/src/fpvectorial.pas
   M /trunk/packages/fpvectorial/src/fpvtocanvas.pas
   M /trunk/packages/fpvectorial/src/pdfvrsemantico.pas
   M /trunk/packages/fpvectorial/src/svgvectorialwriter.pas

Starts implementing svg writer and improves test app and pdf reader
------------------------------------------------------------------------
------------------------------------------------------------------------
r15800 | michael | 2010-08-13 17:19:46 +0200 (Fri, 13 Aug 2010) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/jsonrpc/fpjsonrpc.pp

* Error object must be of type TJSOnErrorObject. Initialize Result to Nil in function TJSONRPCHandler.DoExecute (fixes access violation)
------------------------------------------------------------------------
------------------------------------------------------------------------
r15801 | sekelsenmat | 2010-08-13 17:32:03 +0200 (Fri, 13 Aug 2010) | 1 line
Changed paths:
   M /trunk/packages/fpvectorial/src/fpvectorial.pas
   M /trunk/packages/fpvectorial/src/fpvtocanvas.pas
   M /trunk/packages/fpvectorial/src/svgvectorialwriter.pas

Now the SVG writer works for lines
------------------------------------------------------------------------
------------------------------------------------------------------------
r15802 | sekelsenmat | 2010-08-13 17:34:07 +0200 (Fri, 13 Aug 2010) | 1 line
Changed paths:
   M /trunk/packages/fpvectorial/examples/cdr2svg_mainform.pas

small fix for the fpvectorial example
------------------------------------------------------------------------
------------------------------------------------------------------------
r15804 | marco | 2010-08-14 01:36:07 +0200 (Sat, 14 Aug 2010) | 2 lines
Changed paths:
   M /trunk/rtl/objpas/dateutil.inc

 * fix for 17123, rounding issues decodedatetime

------------------------------------------------------------------------
------------------------------------------------------------------------
r15808 | marco | 2010-08-14 10:56:16 +0200 (Sat, 14 Aug 2010) | 2 lines
Changed paths:
   M /trunk/packages/x11/src/xlib.pp

 * changed chararr32 to pchararr32, see bug #15845

------------------------------------------------------------------------
------------------------------------------------------------------------
r15815 | michael | 2010-08-15 16:22:52 +0200 (Sun, 15 Aug 2010) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/examples/webdata/demo/extgrid.lpr

* Removed resource linking
------------------------------------------------------------------------
------------------------------------------------------------------------
r15816 | michael | 2010-08-15 16:23:59 +0200 (Sun, 15 Aug 2010) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/examples/webdata/demo/wmusers.pp

* Saving of response is now configurable
------------------------------------------------------------------------
------------------------------------------------------------------------
r15817 | michael | 2010-08-15 16:56:37 +0200 (Sun, 15 Aug 2010) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/examples/webdata/demo/wmusers.pp

* Fixed and simplified example
------------------------------------------------------------------------
------------------------------------------------------------------------
r15826 | sekelsenmat | 2010-08-16 10:18:21 +0200 (Mon, 16 Aug 2010) | 1 line
Changed paths:
   D /trunk/packages/fpvectorial/examples/cdr2svg_mainform.lfm
   D /trunk/packages/fpvectorial/examples/cdr2svg_mainform.pas
   D /trunk/packages/fpvectorial/examples/cdr2svg_visual.ico
   D /trunk/packages/fpvectorial/examples/cdr2svg_visual.lpi
   D /trunk/packages/fpvectorial/examples/cdr2svg_visual.lpr
   A /trunk/packages/fpvectorial/examples/fpvc_mainform.lfm
   A /trunk/packages/fpvectorial/examples/fpvc_mainform.pas
   A /trunk/packages/fpvectorial/examples/fpvectorialconverter.ico
   A /trunk/packages/fpvectorial/examples/fpvectorialconverter.lpi
   A /trunk/packages/fpvectorial/examples/fpvectorialconverter.lpr
   M /trunk/packages/fpvectorial/src/fpvectorial.pas

Renames the main fpvectorial example and adds a routine to detect the format from the extension.
------------------------------------------------------------------------
------------------------------------------------------------------------
r15827 | sekelsenmat | 2010-08-16 11:25:46 +0200 (Mon, 16 Aug 2010) | 1 line
Changed paths:
   M /trunk/packages/fcl-image/src/freetype.pp
   M /trunk/packages/fcl-image/src/freetypeh.pp

Patch from Dirk Fellenberg to fix freetype font output, see bug #17156. Also other improvements made by me to improve how freetype linking and font searching under Mac OS X
------------------------------------------------------------------------
------------------------------------------------------------------------
r15829 | sekelsenmat | 2010-08-16 17:00:54 +0200 (Mon, 16 Aug 2010) | 1 line
Changed paths:
   A /trunk/packages/fpvectorial/examples/fpce_mainform.lfm
   A /trunk/packages/fpvectorial/examples/fpce_mainform.pas
   A /trunk/packages/fpvectorial/examples/fpcorelexplorer.ico
   A /trunk/packages/fpvectorial/examples/fpcorelexplorer.lpi
   A /trunk/packages/fpvectorial/examples/fpcorelexplorer.lpr
   M /trunk/packages/fpvectorial/examples/fpvc_mainform.lfm
   M /trunk/packages/fpvectorial/src/cdrvectorialreader.pas
   M /trunk/packages/fpvectorial/src/fpvectorial.pas

Adds a Corel Draw file format explorer and starts implementing the CDR reader in fpvectorial
------------------------------------------------------------------------

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

.gitattributes

@@ -1854,10 +1854,26 @@ packages/fpmkunit/fpmake.pp svneol=native#text/plain
 packages/fpmkunit/src/fpmkunit.pp svneol=native#text/plain
 packages/fpvectorial/Makefile svneol=native#text/plain
 packages/fpvectorial/Makefile.fpc svneol=native#text/plain
+packages/fpvectorial/examples/cdr2svg_mainform.lfm svneol=native#text/plain
+packages/fpvectorial/examples/cdr2svg_mainform.pas svneol=native#text/plain
+packages/fpvectorial/examples/cdr2svg_visual.ico -text
+packages/fpvectorial/examples/cdr2svg_visual.lpi svneol=native#text/plain
+packages/fpvectorial/examples/cdr2svg_visual.lpr svneol=native#text/plain
+packages/fpvectorial/examples/fpce_mainform.lfm svneol=native#text/plain
+packages/fpvectorial/examples/fpce_mainform.pas svneol=native#text/plain
+packages/fpvectorial/examples/fpcorelexplorer.ico -text
+packages/fpvectorial/examples/fpcorelexplorer.lpi svneol=native#text/plain
+packages/fpvectorial/examples/fpcorelexplorer.lpr svneol=native#text/plain
+packages/fpvectorial/examples/fpvc_mainform.lfm svneol=native#text/plain
+packages/fpvectorial/examples/fpvc_mainform.pas svneol=native#text/plain
+packages/fpvectorial/examples/fpvectorialconverter.ico -text
+packages/fpvectorial/examples/fpvectorialconverter.lpi svneol=native#text/plain
+packages/fpvectorial/examples/fpvectorialconverter.lpr svneol=native#text/plain
 packages/fpvectorial/fpmake.pp svneol=native#text/plain
 packages/fpvectorial/src/avisocncgcodereader.pas svneol=native#text/plain
 packages/fpvectorial/src/avisocncgcodewriter.pas svneol=native#text/plain
 packages/fpvectorial/src/avisozlib.pas svneol=native#text/plain
+packages/fpvectorial/src/cdrvectorialreader.pas svneol=native#text/plain
 packages/fpvectorial/src/fpvectbuildunit.pas svneol=native#text/plain
 packages/fpvectorial/src/fpvectorial.pas svneol=native#text/plain
 packages/fpvectorial/src/fpvtocanvas.pas svneol=native#text/plain
@@ -1865,6 +1881,7 @@ packages/fpvectorial/src/pdfvectorialreader.pas svneol=native#text/plain
 packages/fpvectorial/src/pdfvrlexico.pas svneol=native#text/plain
 packages/fpvectorial/src/pdfvrsemantico.pas svneol=native#text/plain
 packages/fpvectorial/src/pdfvrsintatico.pas svneol=native#text/plain
+packages/fpvectorial/src/svgvectorialwriter.pas svneol=native#text/plain
 packages/fuse/Makefile svneol=native#text/plain
 packages/fuse/Makefile.fpc svneol=native#text/plain
 packages/fuse/fpmake_disabled.pp svneol=native#text/plain

compiler/utils/gppc386.pp

@@ -44,10 +44,12 @@ const
   GDBExeName = 'gdbpas';
   GDBIniName = '.gdbinit';
   DefaultCompilerName = 'ppc386';
+  PathSep=':';
 {$else}
   GDBExeName = 'gdbpas.exe';
   GDBIniName = 'gdb.ini';
   DefaultCompilerName = 'ppc386.exe';
+  PathSep=';';
 {$endif not linux}
 
   { If you add a gdb.fpc file in a given directory }
@@ -72,7 +74,7 @@ begin
   { support for info functions directly : used in makefiles }
   if (paramcount=1) and (pos('-i',Paramstr(1))=1) then
     begin
-      Exec(fsearch(CompilerName,GetEnv('PATH')),Paramstr(1));
+      Exec(fsearch(CompilerName,Dir+PathSep+GetEnv('PATH')),Paramstr(1));
       exit;
     end;
 
@@ -114,7 +116,7 @@ begin
   Writeln(fpcgdbini,'end');
   Close(fpcgdbini);
 
-  Exec(fsearch(GDBExeName,GetEnv('PATH')),
+  Exec(fsearch(GDBExeName,Dir+PathSep+GetEnv('PATH')),
 {$ifdef win32}
     '--nw '+
 {$endif win32}

packages/fcl-base/src/custapp.pp

@@ -63,7 +63,7 @@ Type
     Function CheckOptions(Const ShortOptions : String; Const LongOpts : String) : String;
     Procedure GetEnvironmentList(List : TStrings;NamesOnly : Boolean);
     Procedure GetEnvironmentList(List : TStrings);
-    Procedure Log(EventType : TEventType; Msg : String); virtual;
+    Procedure Log(EventType : TEventType; const Msg : String); virtual;
     // Delphi properties
     property ExeName: string read GetExeName;
     property HelpFile: string read FHelpFile write FHelpFile;
@@ -223,7 +223,7 @@ begin
   // Do nothing. Override in descendent classes.
 end;
 
-Procedure TCustomApplication.Log(EventType : TEventType; Msg : String);
+Procedure TCustomApplication.Log(EventType : TEventType; const Msg : String);
 
 begin
   // Do nothing. Override in descendent classes.

packages/fcl-base/src/dummy/eventlog.inc

@@ -32,7 +32,7 @@ begin
   DeActivateFileLog;
 end;
 
-procedure TEventLog.WriteSystemLog(EventType : TEventType; Msg : String);
+procedure TEventLog.WriteSystemLog(EventType : TEventType; const Msg : String);
 
 begin
   WriteFileLog(EventType,Msg);

packages/fcl-base/src/eventlog.pp

@@ -52,8 +52,8 @@ Type
     procedure SetFileName(const Value: String);
     procedure ActivateSystemLog;
     function DefaultFileName: String;
-    procedure WriteFileLog(EventType : TEventType; Msg: String);
-    procedure WriteSystemLog(EventType: TEventType; Msg: String);
+    procedure WriteFileLog(EventType : TEventType; const Msg: String);
+    procedure WriteSystemLog(EventType: TEventType; const Msg: String);
     procedure DeActivateFileLog;
     procedure DeActivateSystemLog;
     procedure CheckIdentification;
@@ -71,18 +71,18 @@ Type
     Function EventTypeToString(E : TEventType) : String;
     Function RegisterMessageFile(AFileName : String) : Boolean; virtual;
     Function UnRegisterMessageFile : Boolean; virtual;
-    Procedure Log (EventType : TEventType; Msg : String); {$ifndef fpc }Overload;{$endif}
-    Procedure Log (EventType : TEventType; Fmt : String; Args : Array of const); {$ifndef fpc }Overload;{$endif}
-    Procedure Log (Msg : String); {$ifndef fpc }Overload;{$endif}
-    Procedure Log (Fmt : String; Args : Array of const); {$ifndef fpc }Overload;{$endif}
-    Procedure Warning (Msg : String); {$ifndef fpc }Overload;{$endif}
-    Procedure Warning (Fmt : String; Args : Array of const); {$ifndef fpc }Overload;{$endif}
-    Procedure Error (Msg : String); {$ifndef fpc }Overload;{$endif}
-    Procedure Error (Fmt : String; Args : Array of const); {$ifndef fpc }Overload;{$endif}
-    Procedure Debug (Msg : String); {$ifndef fpc }Overload;{$endif}
-    Procedure Debug (Fmt : String; Args : Array of const); {$ifndef fpc }Overload;{$endif}
-    Procedure Info (Msg : String); {$ifndef fpc }Overload;{$endif}
-    Procedure Info (Fmt : String; Args : Array of const); {$ifndef fpc }Overload;{$endif}
+    Procedure Log (EventType : TEventType; const Msg : String); {$ifndef fpc }Overload;{$endif}
+    Procedure Log (EventType : TEventType; const Fmt : String; Args : Array of const); {$ifndef fpc }Overload;{$endif}
+    Procedure Log (const Msg : String); {$ifndef fpc }Overload;{$endif}
+    Procedure Log (const Fmt : String; Args : Array of const); {$ifndef fpc }Overload;{$endif}
+    Procedure Warning (const Msg : String); {$ifndef fpc }Overload;{$endif}
+    Procedure Warning (const Fmt : String; Args : Array of const); {$ifndef fpc }Overload;{$endif}
+    Procedure Error (const Msg : String); {$ifndef fpc }Overload;{$endif}
+    Procedure Error (const Fmt : String; Args : Array of const); {$ifndef fpc }Overload;{$endif}
+    Procedure Debug (const Msg : String); {$ifndef fpc }Overload;{$endif}
+    Procedure Debug (const Fmt : String; Args : Array of const); {$ifndef fpc }Overload;{$endif}
+    Procedure Info (const Msg : String); {$ifndef fpc }Overload;{$endif}
+    Procedure Info (const Fmt : String; Args : Array of const); {$ifndef fpc }Overload;{$endif}
   Published
     Property Identification : String Read FIdentification Write SetIdentification;
     Property LogType : TLogType Read Flogtype Write SetlogType;
@@ -126,12 +126,12 @@ begin
     Raise ELogError.Create(SErrOperationNotAllowed);
 end;
 
-procedure TEventLog.Debug(Fmt: String; Args: array of const);
+procedure TEventLog.Debug(const Fmt: String; Args: array of const);
 begin
    Debug(Format(Fmt,Args));
 end;
 
-procedure TEventLog.Debug(Msg: String);
+procedure TEventLog.Debug(const Msg: String);
 begin
   Log(etDebug,Msg);
 end;
@@ -142,38 +142,38 @@ begin
     Active:=True;
 end;
 
-procedure TEventLog.Error(Fmt: String; Args: array of const);
+procedure TEventLog.Error(const Fmt: String; Args: array of const);
 begin
   Error(Format(Fmt,Args));
 end;
 
-procedure TEventLog.Error(Msg: String);
+procedure TEventLog.Error(const Msg: String);
 begin
   Log(etError,Msg);
 end;
 
-procedure TEventLog.Info(Fmt: String; Args: array of const);
+procedure TEventLog.Info(const Fmt: String; Args: array of const);
 begin
   Info(Format(Fmt,Args));
 end;
 
-procedure TEventLog.Info(Msg: String);
+procedure TEventLog.Info(const Msg: String);
 begin
   Log(etInfo,Msg);
 end;
 
-procedure TEventLog.Log(Msg: String);
+procedure TEventLog.Log(const Msg: String);
 begin
   Log(DefaultEventType,msg);
 end;
 
-procedure TEventLog.Log(EventType: TEventType; Fmt: String;
+procedure TEventLog.Log(EventType: TEventType; const Fmt: String;
   Args: array of const);
 begin
   Log(EventType,Format(Fmt,Args));
 end;
 
-procedure TEventLog.Log(EventType: TEventType; Msg: String);
+procedure TEventLog.Log(EventType: TEventType; const Msg: String);
 begin
   EnsureActive;
   Case FlogType of
@@ -182,7 +182,7 @@ begin
   end;
 end;
 
-procedure TEventLog.WriteFileLog(EventType : TEventType; Msg : String);
+procedure TEventLog.WriteFileLog(EventType : TEventType; const Msg : String);
 
 Var
   S,TS,T : String;
@@ -204,7 +204,7 @@ begin
     Raise ELogError.CreateFmt(SErrLogFailedMsg,[S]);
 end;
 
-procedure TEventLog.Log(Fmt: String; Args: array of const);
+procedure TEventLog.Log(const Fmt: String; Args: array of const);
 begin
   Log(Format(Fmt,Args));
 end;
@@ -267,12 +267,12 @@ begin
   Flogtype := Value;
 end;
 
-procedure TEventLog.Warning(Fmt: String; Args: array of const);
+procedure TEventLog.Warning(const Fmt: String; Args: array of const);
 begin
   Warning(Format(Fmt,Args));
 end;
 
-procedure TEventLog.Warning(Msg: String);
+procedure TEventLog.Warning(const Msg: String);
 begin
   Log(etWarning,Msg);
 end;

packages/fcl-base/src/os2/eventlog.inc

@@ -164,7 +164,7 @@ begin
 end;
 
 
-procedure TEventLog.WriteSystemLog (EventType: TEventType; Msg: string);
+procedure TEventLog.WriteSystemLog (EventType: TEventType; const Msg: string);
 
 const
   WinET: array [TEventType] of Str3 = ('USR', 'INF', 'WRN', 'ERR', 'DBG');

packages/fcl-base/src/unix/eventlog.inc

@@ -76,7 +76,7 @@ begin
   CloseLog;
 end;
 
-procedure TEventLog.WriteSystemLog(EventType : TEventType; Msg : String);
+procedure TEventLog.WriteSystemLog(EventType : TEventType; const Msg : String);
 
 Var
   P,PT : PChar;

packages/fcl-base/src/win/eventlog.inc

@@ -49,7 +49,7 @@ function ReportEvent(hEventLog: THandle; wType, wCategory: Word;
   dwDataSize: DWORD; lpStrings, lpRawData: Pointer): BOOL; stdcall;
 }
 
-procedure TEventLog.WriteSystemLog(EventType : TEventType; Msg : String);
+procedure TEventLog.WriteSystemLog(EventType : TEventType; const Msg : String);
 
 Var
   P : PChar;

packages/fcl-db/src/sqlite/customsqliteds.pas

@@ -128,6 +128,7 @@ type
     FPrimaryKeyNo: Integer;
     FFileName: String;
     FSQL: String;
+    FEffectiveSQL: String;
     FTableName: String;
     FSqlFilterTemplate: String;
     FAutoIncFieldNo: Integer;
@@ -924,8 +925,10 @@ begin
   begin
     if FTablename = '' then
       DatabaseError('Tablename not set', Self);
-    FSQL := 'Select * from ' + FTableName + ';';
-  end;
+    FEffectiveSQL := 'Select * from ' + FTableName + ';';
+  end
+  else
+    FEffectiveSQL := FSQL;
 
   if FSqliteHandle = nil then
     GetSqliteHandle;
@@ -1218,7 +1221,7 @@ begin
     FSqlFilterTemplate := FSqlFilterTemplate + FieldDefs[FieldDefs.Count - 1].Name +
       ' FROM ' + FTableName;
   end;
-  //set FSQL considering MasterSource active record
+  //set FEffectiveSQL considering MasterSource active record
   SetDetailFilter;
 end;
 
@@ -1435,7 +1438,7 @@ var
   i: Integer;
 begin
   if (FMasterLink.Dataset.RecordCount = 0) or not FMasterLink.Active then //Retrieve all data
-    FSQL := FSqlFilterTemplate
+    FEffectiveSQL := FSqlFilterTemplate
   else
   begin
     AFilter := ' where ';
@@ -1445,7 +1448,7 @@ begin
       if i <> FMasterLink.Fields.Count - 1 then
         AFilter := AFilter + ' and ';
     end;
-    FSQL := FSqlFilterTemplate + AFilter;
+    FEffectiveSQL := FSqlFilterTemplate + AFilter;
   end;
 end;
 
@@ -1455,7 +1458,7 @@ begin
   {$ifdef DEBUG_SQLITEDS}
   WriteLn('##TCustomSqliteDataset.MasterChanged##');
   WriteLn('  SQL used to filter detail dataset:');
-  WriteLn('  ', FSQL);
+  WriteLn('  ', FEffectiveSQL);
   {$endif}
   RefetchData;
 end;
@@ -1537,8 +1540,7 @@ begin
   ExecSQL(SQLList);
 end;
 
-function TCustomSqliteDataset.GetSQLValue(Values: PPChar; FieldIndex: Integer
-  ): String;
+function TCustomSqliteDataset.GetSQLValue(Values: PPChar; FieldIndex: Integer): String;
 begin
   if (State = dsInactive) or (FieldIndex < 0) or (FieldIndex >= FieldDefs.Count) then
     DatabaseError('Error retrieving SQL value: dataset inactive or field out of range', Self);

packages/fcl-db/src/sqlite/sqlite3ds.pas

@@ -163,7 +163,7 @@ begin
   {$endif}
   FAutoIncFieldNo := -1;
   FieldDefs.Clear;
-  FReturnCode := sqlite3_prepare(FSqliteHandle, PChar(FSQL), -1, @vm, nil);
+  FReturnCode := sqlite3_prepare(FSqliteHandle, PChar(FEffectiveSQL), -1, @vm, nil);
   if FReturnCode <> SQLITE_OK then
     DatabaseError(ReturnString, Self);
   sqlite3_step(vm);
@@ -281,7 +281,7 @@ begin
     sqlite3_exec(FSqliteHandle, PChar('Select Max(' + Fields[FAutoIncFieldNo].FieldName +
       ') from ' + FTableName), @GetAutoIncValue, @FNextAutoInc, nil);
 
-  FReturnCode := sqlite3_prepare(FSqliteHandle, PChar(FSQL), -1, @vm, nil);
+  FReturnCode := sqlite3_prepare(FSqliteHandle, PChar(FEffectiveSQL), -1, @vm, nil);
   if FReturnCode <> SQLITE_OK then
     DatabaseError(ReturnString, Self);
 

packages/fcl-db/src/sqlite/sqliteds.pas

@@ -119,7 +119,7 @@ var
 begin
   FieldDefs.Clear;
   FAutoIncFieldNo := -1;
-  FReturnCode := sqlite_compile(FSqliteHandle, PChar(FSQL), nil, @vm, nil);
+  FReturnCode := sqlite_compile(FSqliteHandle, PChar(FEffectiveSQL), nil, @vm, nil);
   if FReturnCode <> SQLITE_OK then
     DatabaseError(ReturnString, Self);
   sqlite_step(vm, @ColumnCount, @ColumnValues, @ColumnNames);
@@ -231,7 +231,7 @@ begin
     sqlite_exec(FSqliteHandle, PChar('Select Max(' + Fields[FAutoIncFieldNo].FieldName + ') from ' + FTableName),
       @GetAutoIncValue, @FNextAutoInc, nil);
 
-  FReturnCode := sqlite_compile(FSqliteHandle, PChar(FSQL), nil, @vm, nil);
+  FReturnCode := sqlite_compile(FSqliteHandle, PChar(FEffectiveSQL), nil, @vm, nil);
   if FReturnCode <> SQLITE_OK then
     DatabaseError(ReturnString, Self);
 

packages/fcl-extra/src/daemonapp.pp

@@ -57,7 +57,7 @@ Type
     Function UnInstall: boolean; virtual;
     Function HandleCustomCode(ACode : DWord) : Boolean; Virtual;
   Public
-    Procedure LogMessage(Msg : String);
+    Procedure LogMessage(const Msg : String);
     Procedure ReportStatus;
     
     // Filled in at runtime by controller
@@ -370,7 +370,7 @@ Type
     procedure UnInstallDaemons;
     procedure ShowHelp;
     procedure CreateForm(InstanceClass: TComponentClass; var Reference); virtual;
-    procedure Log(EventType: TEventType; Msg: String); override;
+    procedure Log(EventType: TEventType; const Msg: String); override;
     Property  OnRun : TNotifyEvent Read FOnRun Write FOnRun;
     Property EventLog : TEventLog Read GetEventLog;
     Property GUIMainLoop : TGuiLoopEvent Read FGUIMainLoop Write FGuiMainLoop;
@@ -652,7 +652,7 @@ end;
 
 
 
-procedure TCustomDaemon.LogMessage(Msg: String);
+procedure TCustomDaemon.LogMessage(const Msg: String);
 begin
   Application.Log(etInfo,Msg);
 end;
@@ -848,7 +848,7 @@ begin
   end;
 end;
 
-procedure TCustomDaemonApplication.Log(EventType: TEventType; Msg: String);
+procedure TCustomDaemonApplication.Log(EventType: TEventType; const Msg: String);
 begin
   EventLog.Log(EventType,Msg);
 end;

packages/fcl-image/src/freetype.pp

@@ -162,7 +162,14 @@ const
   sErrDestroying : string = 'finalizing FreeType';
 
   DefaultFontExtention : string = '.ttf';
+
+  // Standard location for fonts in the Operating System
+  {$ifdef Darwin}
+  DefaultSearchPath : string = '/Library/Fonts/';
+  {$else}
   DefaultSearchPath : string = '';
+  {$endif}
+
   {$IFDEF MAC}
   DefaultResolution : integer = 72;
   {$ELSE}
@@ -729,7 +736,10 @@ begin
         end;
       end;
     // place position for next glyph
-    pos.x := pos.x + (gl^.advance.x shr 10);
+    // The previous code in this place used shr 10, which
+    // produces wrongly spaced text and looks very ugly
+    // for more information see: http://bugs.freepascal.org/view.php?id=17156
+    pos.x := pos.x + (gl^.advance.x shr 11);
     // pos.y := pos.y + (gl^.advance.y shr 6); // for angled texts also
     if prevx > pos.x then
       pos.x := prevx;

packages/fcl-image/src/freetypeh.pp

@@ -15,17 +15,38 @@
 {$mode objfpc}
 unit freetypeh;
 
-{ These are not all the availlable calls from the dll, but only those
-  I needed for the TStringBitMaps }
+{ Note that these are not all the availlable calls from the dll yet.
+  This unit is used by TStringBitMaps and FTFont }
 
 interface
 
 const
-{$ifdef win32}
+
+{$packrecords c}
+
+// Windows
+{$ifdef windows}
   freetypedll = 'freetype-6.dll';   // version 2.1.4
-  {$packrecords c}
-{$else}
-  // I don't know what it will be ??
+  {$define ft_found_platform}
+{$endif}
+// Mac OS X
+{$ifdef darwin}
+  freetypedll = 'libfreetype'; // Doesn't seam to matter much.
+  {$linklib freetype}          // This one is the important part,
+                               // but you also need to pass to fpc
+                               // the following command:
+                               // -k-L/usr/X11/lib
+                               // or another place where it can find
+                               // libfreetype.dylib
+  {$define ft_found_platform}
+{$endif}
+// LINUX
+{$if defined(UNIX) and not defined(darwin)}
+  freetypedll = 'freetype';
+  {$define ft_found_platform}
+{$endif}
+// Other platforms
+{$ifndef ft_found_platform}
   freetypedll = 'freetype';
 {$endif}
 

packages/fcl-web/examples/webdata/demo/extgrid.lpr

@@ -5,8 +5,6 @@ program extgrid;
 uses
   fpCGI, wmusers;
 
-{$IFDEF WINDOWS}{$R extgrid.rc}{$ENDIF}
-
 begin
   Application.Initialize;
   Application.Run;

packages/fcl-web/examples/webdata/demo/wmusers.pp

@@ -24,6 +24,7 @@ type
       AResponse: TResponse; var Handled: Boolean);
   private
     { private declarations }
+    procedure GetAdaptorAndFormatter(P : TFPWebDataProvider; Var F :TExtJSDataFormatter; ARequest : TRequest; AResponse : TResponse);
   public
     { public declarations }
   end; 
@@ -31,6 +32,9 @@ type
 var
   FPWebModule1: TFPWebModule1; 
 
+Var
+  ResponseFileName : String; // Set to non empty to write request responses to a file.
+
 implementation
 {$define wmdebug}
 
@@ -40,6 +44,38 @@ uses dbugintf;
 
 { TFPWebModule1 }
 
+Procedure SaveResponse(M : TStream);
+
+begin
+  if (ResponseFileName<>'') then
+    With TFileStream.Create(ResponseFileName,fmCreate) do
+      try
+        CopyFrom(M,0);
+      finally
+        Free;
+      end;
+end;
+
+procedure TFPWebModule1.GetAdaptorAndFormatter(P : TFPWebDataProvider; Var F :TExtJSDataFormatter; ARequest : TRequest; AResponse : TResponse);
+
+begin
+  If Request.QueryFields.values['format']='xml' then
+    begin
+    F:=TExtJSXMLDataFormatter.Create(Self);
+    TExtJSXMLDataFormatter(F).TotalProperty:='total';
+    AResponse.ContentType:='text/xml';
+    P.Adaptor:=TExtJSXMLWebdataInputAdaptor.Create(Nil); 
+    end
+  else
+    begin
+    P.Adaptor:=TExtJSJSonWebdataInputAdaptor.Create(Nil); 
+    F:=TExtJSJSONDataFormatter.Create(Self);
+    end;
+  P.Adaptor.Request:=ARequest;
+  F.Adaptor:=P.Adaptor;
+  F.Provider:=P;
+end;
+
 procedure TFPWebModule1.TFPWebActions0Request(Sender: TObject;
   ARequest: TRequest; AResponse: TResponse; var Handled: Boolean);
 
@@ -54,19 +90,9 @@ Var
 begin
   // Providername;
   PN:=ARequest.GetNextPathInfo;
-//  P:=GetWebDataProvider(PN);
   P:=TFPWebDataProvider.Create(Self);
   try
-    P.Adaptor:=TWebDataInputAdaptor.Create(Self);
-    P.Adaptor.Request:=ARequest;
-    If Request.QueryFields.values['format']='xml' then
-      begin
-      F:=TExtJSXMLDataFormatter.Create(Self);
-      TExtJSXMLDataFormatter(F).TotalProperty:='total';
-      AResponse.ContentType:='text/xml';
-      end
-    else
-      F:=TExtJSJSONDataFormatter.Create(Self);
+    GetAdaptorAndFormatter(P,F,ARequest,AResponse);
     {$ifdef wmdebug} SendDebug(className+' '+F.ClassName);{$endif}
     try
       DS:=TDatasource.Create(Self);
@@ -75,11 +101,9 @@ begin
         DS.Dataset:=DBf1;
         DBF1.Open;
         try
-          F.ADaptor:=P.Adaptor;
           P.Datasource:=DS;
           P.Adaptor.Action:=wdaRead;
           P.ApplyParams;
-          F.Provider:=P;
           M:=TMemoryStream.Create;
           try
             F.GetContent(ARequest,M,Handled);
@@ -87,12 +111,7 @@ begin
             Response.ContentStream:=M;
             Response.SendResponse;
             Response.ContentStream:=Nil;
-            With TFileStream.Create('/tmp/data.xml',fmCreate) do
-              try
-                CopyFrom(M,0);
-              finally
-                Free;
-              end;
+            SaveResponse(M);
           finally
             M.Free;
           end;
@@ -127,18 +146,7 @@ begin
   P:=TFPWebDataProvider.Create(Self);
   try
     P.IDFieldName:='ID';
-    If Request.QueryFields.values['format']='xml' then
-      begin
-      F:=TExtJSXMLDataFormatter.Create(Self);
-      AResponse.ContentType:='text/xml';
-      P.Adaptor:=TWebDataInputAdaptor.Create(Self);
-      end
-    else
-      begin
-      F:=TExtJSJSONDataFormatter.Create(Self);
-      P.Adaptor:=TExtJSJSonWebdataInputAdaptor.Create(Self);
-      end;
-    P.Adaptor.Request:=ARequest;
+    GetAdaptorAndFormatter(P,F,ARequest,AResponse);
     {$ifdef wmdebug} SendDebug(className+' '+F.ClassName);{$endif}
     try
       DS:=TDatasource.Create(Self);
@@ -147,11 +155,9 @@ begin
         DS.Dataset:=DBf1;
         DBF1.Open;
         try
-          F.ADaptor:=P.Adaptor;
           P.Datasource:=DS;
           P.Adaptor.Action:=wdaInsert;
           P.ApplyParams;
-          F.Provider:=P;
           M:=TMemoryStream.Create;
           try
             F.GetContent(ARequest,M,Handled);
@@ -159,12 +165,7 @@ begin
             Response.ContentStream:=M;
             Response.SendResponse;
             Response.ContentStream:=Nil;
-            With TFileStream.Create('/tmp/data.xml',fmCreate) do
-              try
-                CopyFrom(M,0);
-              finally
-                Free;
-              end;
+            SaveResponse(M);
           finally
             M.Free;
           end;
@@ -200,19 +201,7 @@ begin
   P:=TFPWebDataProvider.Create(Self);
   try
     P.IDFieldName:='ID';
-    If Request.QueryFields.values['format']='xml' then
-      begin
-      {$ifdef wmdebug} SendDebug('Update request received in XML');{$endif}
-      F:=TExtJSXMLDataFormatter.Create(Self);
-      AResponse.ContentType:='text/xml';
-      P.Adaptor:=TWebDataInputAdaptor.Create(Self);
-      end
-    else
-      begin
-      F:=TExtJSJSONDataFormatter.Create(Self);
-      P.Adaptor:=TExtJSJSonWebdataInputAdaptor.Create(Self);
-      end;
-    P.Adaptor.Request:=ARequest;
+    GetAdaptorAndFormatter(P,F,ARequest,AResponse);
     {$ifdef wmdebug} SendDebug(className+' '+F.ClassName);{$endif}
     try
       DS:=TDatasource.Create(Self);
@@ -221,11 +210,9 @@ begin
         DS.Dataset:=DBf1;
         DBF1.Open;
         try
-          F.ADaptor:=P.Adaptor;
           P.Datasource:=DS;
           P.Adaptor.Action:=wdaUpdate;
           P.ApplyParams;
-          F.Provider:=P;
           M:=TMemoryStream.Create;
           try
             F.GetContent(ARequest,M,Handled);
@@ -233,12 +220,7 @@ begin
             Response.ContentStream:=M;
             Response.SendResponse;
             Response.ContentStream:=Nil;
-            With TFileStream.Create('/tmp/data.xml',fmCreate) do
-              try
-                CopyFrom(M,0);
-              finally
-                Free;
-              end;
+            SaveResponse(M);
           finally
             M.Free;
           end;
@@ -274,18 +256,7 @@ begin
   P:=TFPWebDataProvider.Create(Self);
   try
     P.IDFieldName:='ID';
-    If Request.QueryFields.values['format']='xml' then
-      begin
-      F:=TExtJSXMLDataFormatter.Create(Self);
-      AResponse.ContentType:='text/xml';
-      P.Adaptor:=TWebDataInputAdaptor.Create(Self);
-      end
-    else
-      begin
-      F:=TExtJSJSONDataFormatter.Create(Self);
-      P.Adaptor:=TExtJSJSonWebdataInputAdaptor.Create(Self);
-      end;
-    P.Adaptor.Request:=ARequest;
+    GetAdaptorAndFormatter(P,F,ARequest,AResponse);
     {$ifdef wmdebug} SendDebug('className '+F.ClassName);{$endif}
     try
       DS:=TDatasource.Create(Self);
@@ -294,11 +265,9 @@ begin
         DS.Dataset:=DBf1;
         DBF1.Open;
         try
-          F.ADaptor:=P.Adaptor;
           P.Datasource:=DS;
           P.Adaptor.Action:=wdaDelete;
           P.ApplyParams;
-          F.Provider:=P;
           M:=TMemoryStream.Create;
           try
             F.GetContent(ARequest,M,Handled);
@@ -306,12 +275,7 @@ begin
             Response.ContentStream:=M;
             Response.SendResponse;
             Response.ContentStream:=Nil;
-            With TFileStream.Create('/tmp/data.xml',fmCreate) do
-              try
-                CopyFrom(M,0);
-              finally
-                Free;
-              end;
+            SaveResponse(M);
           finally
             M.Free;
           end;

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

@@ -25,18 +25,18 @@ uses
 
 Type
   { TCGIRequest }
-  TCustomCGIApplication = Class;
+  TCGIHandler = Class;
 
   TCGIRequest = Class(TRequest)
   Private
-    FCGI : TCustomCGIApplication;
+    FCGI : TCGIHandler;
     function GetCGIVar(Index: integer): String;
   Protected
     Function GetFieldValue(Index : Integer) : String; override;
     Procedure InitFromEnvironment;
     procedure ReadContent; override;
   Public
-    Constructor CreateCGI(ACGI : TCustomCGIApplication);
+    Constructor CreateCGI(ACGI : TCGIHandler);
     Property GatewayInterface : String Index 1 Read GetCGIVar;
     Property RemoteIdent : String Index 2 read GetCGIVar;
     Property RemoteUser : String Index 3 read GetCGIVar;
@@ -50,24 +50,22 @@ Type
 
   TCGIResponse = Class(TResponse)
   private
-    FCGI : TCustomCGIApplication;
+    FCGI : TCGIHandler;
     FOutput : TStream;
   Protected
     Procedure DoSendHeaders(Headers : TStrings); override;
     Procedure DoSendContent; override;
   Public
-    Constructor CreateCGI(ACGI : TCustomCGIApplication; AStream : TStream);
+    Constructor CreateCGI(ACGI : TCGIHandler; AStream : TStream);
   end;
 
   { TCustomCgiApplication }
 
-  TCustomCGIApplication = Class(TCustomWebApplication)
+  TCgiHandler = Class(TWebHandler)
   Private
     FResponse : TCGIResponse;
     FRequest : TCGIRequest;
     FOutput : TStream;
-    Function GetRequestVariable(Const VarName : String) : String;
-    Function GetRequestVariableCount : Integer;
   protected
     Function GetEmail : String; override;
     Function GetAdministrator : String; override;
@@ -76,20 +74,37 @@ Type
     function WaitForRequest(out ARequest : TRequest; out AResponse : TResponse) : boolean; override;
     procedure EndRequest(ARequest : TRequest;AResponse : TResponse); override;
   Public
+    Procedure GetCGIVarList(List : TStrings);
     Property Request : TCGIRequest read FRequest;
     Property Response: TCGIResponse Read FResponse;
+  end;
+
+  { TCustomCgiApplication }
+
+  TCustomCGIApplication = Class(TCustomWebApplication)
+  private
+    function GetRequest: TCGIRequest;
+    function GetRequestVariable(VarName : String): String;
+    function GetRequestVariableCount: Integer;
+    function GetResponse: TCGIResponse;
+  protected
+    function InitializeWebHandler: TWebHandler; override;
+  public
+    Procedure ShowException(E: Exception);override;
+    Property Request : TCGIRequest read GetRequest;
+    Property Response: TCGIResponse Read GetResponse;
     Procedure AddResponse(Const S : String);
     Procedure AddResponse(Const Fmt : String; Args : Array of const);
     Procedure AddResponseLn(Const S : String);
     Procedure AddResponseLn(Const Fmt : String; Args : Array of const);
     Procedure GetCGIVarList(List : TStrings);
-    Procedure ShowException(E: Exception);override;
     Function VariableIsUploadedFile(Const VarName : String) : boolean;
     Function UploadedFileName(Const VarName : String) : String;
     Property RequestVariables[VarName : String] : String Read GetRequestVariable;
     Property RequestVariableCount : Integer Read GetRequestVariableCount;
   end;
 
+
 ResourceString
   SWebMaster = 'webmaster';
   SErrNoContentLength = 'No content length passed from server!';
@@ -143,7 +158,7 @@ Const
     { 36: 'XHTTPREQUESTEDWITH'     } ''
   );
 
-Procedure TCustomCGIApplication.GetCGIVarList(List : TStrings);
+Procedure TCgiHandler.GetCGIVarList(List : TStrings);
 
 Var
   I : Integer;
@@ -154,16 +169,7 @@ begin
     List.Add(CGIVarNames[i]+'='+GetEnvironmentVariable(CGIVarNames[i]));
 end;
 
-
-Procedure TCustomCGIApplication.ShowException(E: Exception);
-begin
-  if assigned(FResponse) then
-    ShowRequestException(FResponse,E)
-  else
-    inherited ShowException(E);
-end;
-
-Function TCustomCGIApplication.GetEmail : String;
+Function TCgiHandler.GetEmail : String;
 
 Var
   H : String;
@@ -178,7 +184,7 @@ begin
     end;
 end;
 
-Function TCustomCGIApplication.GetAdministrator : String;
+Function TCgiHandler.GetAdministrator : String;
 
 begin
   Result:=Inherited GetAdministrator;
@@ -186,17 +192,17 @@ begin
     Result:=SWebMaster;
 end;
 
-function TCustomCGIApplication.CreateResponse(AOutput : TStream): TCGIResponse;
+function TCgiHandler.CreateResponse(AOutput : TStream): TCGIResponse;
 begin
-  TCGIResponse.CreateCGI(Self,AOutput);
+  result := TCGIResponse.CreateCGI(Self,AOutput);
 end;
 
-function TCustomCGIApplication.CreateRequest: TCGIRequest;
+function TCgiHandler.CreateRequest: TCGIRequest;
 begin
   Result:=TCGIRequest.CreateCGI(Self);
 end;
 
-function TCustomCGIApplication.WaitForRequest(out ARequest: TRequest; out AResponse: TResponse): boolean;
+function TCgiHandler.WaitForRequest(out ARequest: TRequest; out AResponse: TResponse): boolean;
 begin
   FRequest:=CreateRequest;
   FRequest.InitFromEnvironment;
@@ -208,83 +214,19 @@ begin
   Result := True;
 end;
 
-procedure TCustomCGIApplication.EndRequest(ARequest: TRequest;
-  AResponse: TResponse);
+procedure TCgiHandler.EndRequest(ARequest: TRequest; AResponse: TResponse);
 begin
   inherited;
   FreeAndNil(FOutPut);
   Terminate;
 end;
 
-constructor TCGIRequest.CreateCGI(ACGI: TCustomCGIApplication);
+constructor TCgiRequest.CreateCGI(ACGI: TCgiHandler);
 begin
   Inherited Create;
   FCGI:=ACGI;
 end;
 
-Function TCustomCGIApplication.GetRequestVariable(Const VarName : String) : String;
-
-begin
- If Assigned(Request) then
-   Result:=FRequest.QueryFields.Values[VarName]
- else
-   Result:='';
-end;
-
-Function TCustomCGIApplication.GetRequestVariableCount : Integer;
-
-begin
- If Assigned(Request) then
-    Result:=FRequest.QueryFields.Count
-  else
-    Result:=0;
-end;
-
-Procedure TCustomCGIApplication.AddResponse(Const S : String);
-
-Var
-  L : Integer;
-
-begin
-  L:=Length(S);
-  If L>0 then
-    Response.Content:=Response.Content+S;
-end;
-
-Procedure TCustomCGIApplication.AddResponse(Const Fmt : String; Args : Array of const);
-
-begin
-  AddResponse(Format(Fmt,Args));
-end;
-
-Procedure TCustomCGIApplication.AddResponseLN(Const S : String);
-
-
-begin
-  AddResponse(S+LineEnding);
-end;
-
-Procedure TCustomCGIApplication.AddResponseLN(Const Fmt : String; Args : Array of const);
-
-begin
-  AddResponseLN(Format(Fmt,Args));
-end;
-
-Function TCustomCGIApplication.VariableIsUploadedFile(Const VarName : String) : boolean;
-
-begin
-  Result:=FRequest.Files.IndexOfFile(VarName)<>-1;
-end;
-
-Function TCustomCGIApplication.UploadedFileName(Const VarName : String) : String;
-
-begin
-  If VariableIsUploadedFile(VarName) then
-    Result:=FRequest.Files.FileByName(VarName).LocalFileName
-  else
-    Result:='';
-end;
-
 { TCGIHTTPRequest }
 
 function TCGIRequest.GetCGIVar(Index: integer): String;
@@ -433,13 +375,100 @@ begin
 {$endif}
 end;
 
-constructor TCGIResponse.CreateCGI(ACGI: TCustomCGIApplication; AStream: TStream);
+constructor TCGIResponse.CreateCGI(ACGI: TCgiHandler; AStream: TStream);
 begin
   inherited Create(ACGI.Request);
   FCGI:=ACGI;
   FOutput:=AStream;
 end;
 
+{ TCustomCGIApplication }
+
+function TCustomCGIApplication.GetRequest: TCGIRequest;
+begin
+  result := TCgiHandler(WebHandler).Request;
+end;
+
+function TCustomCGIApplication.GetRequestVariable(VarName : String): String;
+begin
+  If Assigned(Request) then
+    Result:=Request.QueryFields.Values[VarName]
+  else
+    Result:='';
+end;
+
+function TCustomCGIApplication.GetRequestVariableCount: Integer;
+begin
+  If Assigned(Request) then
+     Result:=Request.QueryFields.Count
+   else
+     Result:=0;
+end;
+
+function TCustomCGIApplication.GetResponse: TCGIResponse;
+begin
+
+end;
+
+function TCustomCGIApplication.InitializeWebHandler: TWebHandler;
+begin
+  Result:=TCgiHandler.Create(self);
+end;
+
+Procedure TCustomCGIApplication.ShowException(E: Exception);
+var
+  CgiHandler: TCgiHandler;
+begin
+  CgiHandler := WebHandler as TCgiHandler;
+  if assigned(CgiHandler.FResponse) then
+    CgiHandler.ShowRequestException(CgiHandler.FResponse,E)
+  else
+    inherited ShowException(E);
+end;
+
+procedure TCustomCGIApplication.AddResponse(const S: String);
+Var
+  L : Integer;
+
+begin
+  L:=Length(S);
+  If L>0 then
+    Response.Content:=Response.Content+S;
+end;
+
+procedure TCustomCGIApplication.AddResponse(const Fmt: String; Args: array of const);
+begin
+  AddResponse(Format(Fmt,Args));
+end;
+
+procedure TCustomCGIApplication.AddResponseLn(const S: String);
+begin
+  AddResponse(S+LineEnding);
+end;
+
+procedure TCustomCGIApplication.AddResponseLn(const Fmt: String; Args: array of const);
+begin
+  AddResponseLN(Format(Fmt,Args));
+end;
+
+procedure TCustomCGIApplication.GetCGIVarList(List: TStrings);
+begin
+  TCgiHandler(WebHandler).GetCGIVarList(list);
+end;
+
+function TCustomCGIApplication.VariableIsUploadedFile(const VarName: String): boolean;
+begin
+  Result:=Request.Files.IndexOfFile(VarName)<>-1;
+end;
+
+function TCustomCGIApplication.UploadedFileName(const VarName: String): String;
+begin
+  If VariableIsUploadedFile(VarName) then
+    Result:=Request.Files.FileByName(VarName).LocalFileName
+  else
+    Result:='';
+end;
+
 initialization
 
 finalization

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

@@ -75,9 +75,7 @@ Type
              Response : TFCgiResponse;
              end;
 
-  { TCustomFCgiApplication }
-
-  TCustomFCgiApplication = Class(TCustomWebApplication)
+  TFCgiHandler = class(TWebHandler)
   Private
     FOnUnknownRecord: TUnknownRecordEvent;
     FPO: TProtoColOptions;
@@ -100,6 +98,27 @@ Type
     Property OnUnknownRecord : TUnknownRecordEvent Read FOnUnknownRecord Write FOnUnknownRecord;
   end;
 
+  { TCustomFCgiApplication }
+
+  TCustomFCgiApplication = Class(TCustomWebApplication)
+  private
+    function GetAddress: string;
+    function GetFPO: TProtoColOptions;
+    function GetOnUnknownRecord: TUnknownRecordEvent;
+    function GetPort: integer;
+    procedure SetAddress(const AValue: string);
+    procedure SetOnUnknownRecord(const AValue: TUnknownRecordEvent);
+    procedure SetPort(const AValue: integer);
+    procedure SetPO(const AValue: TProtoColOptions);
+  protected
+    function InitializeWebHandler: TWebHandler; override;
+  Public
+    property Port: integer read GetPort write SetPort;
+    property Address: string read GetAddress write SetAddress;
+    Property ProtocolOptions : TProtoColOptions Read GetFPO Write SetPO;
+    Property OnUnknownRecord : TUnknownRecordEvent Read GetOnUnknownRecord Write SetOnUnknownRecord;
+  end;
+
 ResourceString
   SNoInputHandle = 'Failed to open input-handle passed from server. Socket Error: %d';
   SNoSocket      = 'Failed to open socket. Socket Error: %d';
@@ -157,6 +176,7 @@ begin
                           begin
                           Result := True;
                           InitRequestVars;
+                          ParseCookies;
                           end
                         else
                           begin
@@ -372,9 +392,9 @@ begin
   Write_FCGIRecord(PFCGI_Header(@EndRequest));
 end;
 
-{ TCustomFCgiApplication }
+{ TFCgiHandler }
 
-constructor TCustomFCgiApplication.Create(AOwner: TComponent);
+constructor TFCgiHandler.Create(AOwner: TComponent);
 begin
   Inherited Create(AOwner);
   FRequestsAvail:=5;
@@ -382,7 +402,7 @@ begin
   FHandle := THandle(-1);
 end;
 
-destructor TCustomFCgiApplication.Destroy;
+destructor TFCgiHandler.Destroy;
 begin
   SetLength(FRequestsArray,0);
   if (Socket<>0) then
@@ -393,7 +413,7 @@ begin
   inherited Destroy;
 end;
 
-procedure TCustomFCgiApplication.EndRequest(ARequest: TRequest; AResponse: TResponse);
+procedure TFCgiHandler.EndRequest(ARequest: TRequest; AResponse: TResponse);
 begin
   with FRequestsArray[TFCGIRequest(ARequest).RequestID] do
     begin
@@ -411,7 +431,7 @@ begin
   Inherited;
 end;
 
-function TCustomFCgiApplication.Read_FCGIRecord : PFCGI_Header;
+function TFCgiHandler.Read_FCGIRecord : PFCGI_Header;
 
 var Header : FCGI_Header;
     BytesRead : integer;
@@ -453,7 +473,7 @@ begin
   Result := ResRecord;
 end;
 
-function TCustomFCgiApplication.WaitForRequest(out ARequest: TRequest; out AResponse: TResponse): boolean;
+function TFCgiHandler.WaitForRequest(out ARequest: TRequest; out AResponse: TResponse): boolean;
 var
   IAddress      : TInetSockAddr;
   AddressLength : tsocklen;
@@ -495,10 +515,10 @@ begin
       Socket:=StdInputHandle;
     end;
 
-  if FHandle=-1 then
+  if FHandle=THandle(-1) then
     begin
     FHandle:=fpaccept(Socket,psockaddr(@IAddress),@AddressLength);
-    if FHandle=-1 then
+    if FHandle=THandle(-1) then
       raise Exception.CreateFmt(SNoInputHandle,[socketerror]);
     end;
 
@@ -534,7 +554,54 @@ begin
       Break;
       end;
     end;
-  until Terminated;
+  until (1<>1);
+end;
+
+{ TCustomFCgiApplication }
+
+function TCustomFCgiApplication.GetAddress: string;
+begin
+  result := TFCgiHandler(WebHandler).Address;
+end;
+
+function TCustomFCgiApplication.GetFPO: TProtoColOptions;
+begin
+  result := TFCgiHandler(WebHandler).ProtocolOptions;
+end;
+
+function TCustomFCgiApplication.GetOnUnknownRecord: TUnknownRecordEvent;
+begin
+  result := TFCgiHandler(WebHandler).OnUnknownRecord;
+end;
+
+function TCustomFCgiApplication.GetPort: integer;
+begin
+  result := TFCgiHandler(WebHandler).Port;
+end;
+
+procedure TCustomFCgiApplication.SetAddress(const AValue: string);
+begin
+  TFCgiHandler(WebHandler).Address := AValue;
+end;
+
+procedure TCustomFCgiApplication.SetOnUnknownRecord(const AValue: TUnknownRecordEvent);
+begin
+  TFCgiHandler(WebHandler).OnUnknownRecord := AValue;
+end;
+
+procedure TCustomFCgiApplication.SetPort(const AValue: integer);
+begin
+  TFCgiHandler(WebHandler).Port := AValue;
+end;
+
+procedure TCustomFCgiApplication.SetPO(const AValue: TProtoColOptions);
+begin
+  TFCgiHandler(WebHandler).ProtocolOptions := AValue;
+end;
+
+function TCustomFCgiApplication.InitializeWebHandler: TWebHandler;
+begin
+  Result:=TFCgiHandler.Create(self);
 end;
 
 end.

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

@@ -71,13 +71,19 @@ Const
     );
 
 Type
+
   { TCustomWebApplication }
+
   TGetModuleEvent = Procedure (Sender : TObject; ARequest : TRequest;
                                Var ModuleClass : TCustomHTTPModuleClass) of object;
   TOnShowRequestException = procedure(AResponse: TResponse; AnException: Exception; var handled: boolean);
 
-  TCustomWebApplication = Class(TCustomApplication)
-  Private
+  { TWebHandler }
+
+  TWebHandler = class(TComponent)
+  private
+    FOnIdle: TNotifyEvent;
+    FTerminated: boolean;
     FAdministrator: String;
     FAllowDefaultModule: Boolean;
     FApplicationURL: String;
@@ -89,28 +95,24 @@ Type
     FHandleGetOnPost : Boolean;
     FRedirectOnError : Boolean;
     FRedirectOnErrorURL : String;
-    FEventLog: TEventLog;
-    function GetEventLog: TEventLog;
+    FTitle: string;
+    FOnTerminate : TNotifyEvent;
   protected
+    procedure Terminate;
     Function GetModuleName(Arequest : TRequest) : string;
     function WaitForRequest(out ARequest : TRequest; out AResponse : TResponse) : boolean; virtual; abstract;
     procedure EndRequest(ARequest : TRequest;AResponse : TResponse); virtual;
     function FindModule(ModuleClass : TCustomHTTPModuleClass): TCustomHTTPModule;
     Procedure SetBaseURL(AModule : TCustomHTTPModule; Const AModuleName : String; ARequest : TRequest); virtual;
     function GetApplicationURL(ARequest : TRequest): String; virtual;
-    Procedure DoRun; override;
     procedure ShowRequestException(R: TResponse; E: Exception); virtual;
     Function GetEmail : String; virtual;
     Function GetAdministrator : String; virtual;
   Public
     constructor Create(AOwner: TComponent); override;
-    destructor Destroy; override;
-    Procedure CreateForm(AClass : TComponentClass; out Reference);
-    Procedure Initialize; override;
-    Procedure ShowException(E: Exception);override;
+    Procedure Run; virtual;
     Procedure DoHandleRequest(ARequest : TRequest; AResponse : TResponse);
     Procedure HandleRequest(ARequest : TRequest; AResponse : TResponse); virtual;
-    Procedure Log(EventType: TEventType; Msg: String); override;
     Property HandleGetOnPost : Boolean Read FHandleGetOnPost Write FHandleGetOnPost;
     Property RedirectOnError : boolean Read FRedirectOnError Write FRedirectOnError;
     Property RedirectOnErrorURL : string Read FRedirectOnErrorURL Write FRedirectOnErrorURL;
@@ -120,8 +122,60 @@ Type
     Property ModuleVariable : String Read FModuleVar Write FModuleVar;
     Property OnGetModule : TGetModuleEvent Read FOnGetModule Write FOnGetModule;
     Property Email : String Read GetEmail Write FEmail;
+    property Title: string read FTitle write FTitle;
     Property Administrator : String Read GetAdministrator Write FAdministrator;
     property OnShowRequestException: TOnShowRequestException read FOnShowRequestException write FOnShowRequestException;
+    property OnIdle: TNotifyEvent read FOnIdle write FOnIdle;
+  end;
+
+  TCustomWebApplication = Class(TCustomApplication)
+  Private
+    FEventLog: TEventLog;
+    FWebHandler: TWebHandler;
+    function GetAdministrator: String;
+    function GetAllowDefaultModule: Boolean;
+    function GetApplicationURL: String;
+    function GetEmail: String;
+    function GetEventLog: TEventLog;
+    function GetHandleGetOnPost: Boolean;
+    function GetModuleVar: String;
+    function GetOnGetModule: TGetModuleEvent;
+    function GetOnShowRequestException: TOnShowRequestException;
+    function GetRedirectOnError: boolean;
+    function GetRedirectOnErrorURL: string;
+    procedure SetAdministrator(const AValue: String);
+    procedure SetAllowDefaultModule(const AValue: Boolean);
+    procedure SetApplicationURL(const AValue: String);
+    procedure SetEmail(const AValue: String);
+    procedure SetHandleGetOnPost(const AValue: Boolean);
+    procedure SetModuleVar(const AValue: String);
+    procedure SetOnGetModule(const AValue: TGetModuleEvent);
+    procedure SetOnShowRequestException(const AValue: TOnShowRequestException);
+    procedure SetRedirectOnError(const AValue: boolean);
+    procedure SetRedirectOnErrorURL(const AValue: string);
+    procedure DoOnTerminate(Sender : TObject);
+  protected
+    Procedure DoRun; override;
+    function InitializeWebHandler: TWebHandler; virtual; abstract;
+    procedure SetTitle(const AValue: string); override;
+    property WebHandler: TWebHandler read FWebHandler write FWebHandler;
+  Public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    Procedure CreateForm(AClass : TComponentClass; out Reference);
+    Procedure Initialize; override;
+    Procedure Log(EventType: TEventType; const Msg: String); override;
+    procedure Terminate; override;
+    Property HandleGetOnPost : Boolean Read GetHandleGetOnPost Write SetHandleGetOnPost;
+    Property RedirectOnError : boolean Read GetRedirectOnError Write SetRedirectOnError;
+    Property RedirectOnErrorURL : string Read GetRedirectOnErrorURL Write SetRedirectOnErrorURL;
+    Property ApplicationURL : String Read GetApplicationURL Write SetApplicationURL;
+    Property AllowDefaultModule : Boolean Read GetAllowDefaultModule Write SetAllowDefaultModule;
+    Property ModuleVariable : String Read GetModuleVar Write SetModuleVar;
+    Property OnGetModule : TGetModuleEvent Read GetOnGetModule Write SetOnGetModule;
+    Property Email : String Read GetEmail Write SetEmail;
+    Property Administrator : String Read GetAdministrator Write SetAdministrator;
+    property OnShowRequestException: TOnShowRequestException read GetOnShowRequestException write SetOnShowRequestException;
     Property EventLog: TEventLog read GetEventLog;
   end;
 
@@ -173,18 +227,20 @@ begin
     end;
 end;
 
-procedure TCustomWebApplication.DoRun;
+procedure TWebHandler.Run;
 var ARequest : TRequest;
     AResponse : TResponse;
 begin
-  while not Terminated do
+  while not FTerminated do
     begin
     if WaitForRequest(ARequest,AResponse) then
       DoHandleRequest(ARequest,AResponse);
+    if assigned(OnIdle) then
+      OnIdle(Self);
     end;
 end;
 
-procedure TCustomWebApplication.ShowRequestException(R: TResponse; E: Exception);
+procedure TWebHandler.ShowRequestException(R: TResponse; E: Exception);
 Var
  S : TStrings;
  handled: boolean;
@@ -221,27 +277,17 @@ begin
     end;
 end;
 
-function TCustomWebApplication.GetEmail: String;
+function TWebHandler.GetEmail: String;
 begin
   Result := FEmail;
 end;
 
-function TCustomWebApplication.GetAdministrator: String;
+function TWebHandler.GetAdministrator: String;
 begin
   Result := FAdministrator;
 end;
 
-procedure TCustomWebApplication.ShowException(E: Exception);
-var Buf:ShortString;
-begin
-{$ifdef CGIDEBUG}
-  SetLength(Buf,ExceptionErrorMessage(ExceptObject,ExceptAddr,@Buf[1],255));
-  senddebug('Exception: ' + Buf);
-{$endif CGIDEBUG}
-  inherited ShowException(E);
-end;
-
-procedure TCustomWebApplication.HandleRequest(ARequest: TRequest; AResponse: TResponse);
+procedure TWebHandler.HandleRequest(ARequest: TRequest; AResponse: TResponse);
 Var
   MC : TCustomHTTPModuleClass;
   M  : TCustomHTTPModule;
@@ -285,33 +331,21 @@ begin
   end;
 end;
 
-procedure TCustomWebApplication.Log(EventType: TEventType; Msg: String);
-begin
-  EventLog.log(EventType,Msg);
-end;
-
-Procedure TCustomWebApplication.Initialize;
-
-begin
-  StopOnException:=True;
-  Inherited;
-end;
-
-function TCustomWebApplication.GetEventLog: TEventLog;
-begin
-  if not assigned(FEventLog) then
-    FEventLog := TEventLog.Create(self);
-  Result := FEventLog;
-end;
-
-function TCustomWebApplication.GetApplicationURL(ARequest: TRequest): String;
+function TWebHandler.GetApplicationURL(ARequest: TRequest): String;
 begin
   Result:=FApplicationURL;
   If (Result='') then
     Result:=ARequest.ScriptName;
 end;
 
-function TCustomWebApplication.GetModuleName(Arequest: TRequest): string;
+procedure TWebHandler.Terminate;
+begin
+  FTerminated := true;
+  If Assigned(FOnTerminate) then 
+    FOnTerminate(Self);
+end;
+
+function TWebHandler.GetModuleName(Arequest: TRequest): string;
 
    Function GetDefaultModuleName : String;
 
@@ -344,13 +378,13 @@ begin
     end;
 end;
 
-procedure TCustomWebApplication.EndRequest(ARequest: TRequest; AResponse: TResponse);
+procedure TWebHandler.EndRequest(ARequest: TRequest; AResponse: TResponse);
 begin
   AResponse.Free;
   ARequest.Free;
 end;
 
-function TCustomWebApplication.FindModule(ModuleClass: TCustomHTTPModuleClass): TCustomHTTPModule;
+function TWebHandler.FindModule(ModuleClass: TCustomHTTPModuleClass): TCustomHTTPModule;
 Var
   I : Integer;
 begin
@@ -363,7 +397,7 @@ begin
     Result:=Nil;
 end;
 
-procedure TCustomWebApplication.SetBaseURL(AModule: TCustomHTTPModule;
+procedure TWebHandler.SetBaseURL(AModule: TCustomHTTPModule;
   Const AModuleName : String; ARequest: TRequest);
 
 Var
@@ -382,7 +416,7 @@ begin
   AModule.BaseURL:=S+P;
 end;
 
-procedure TCustomWebApplication.DoHandleRequest(ARequest: TRequest; AResponse: TResponse);
+procedure TWebHandler.DoHandleRequest(ARequest: TRequest; AResponse: TResponse);
 begin
   HandleRequest(ARequest,AResponse);
   If Not AResponse.ContentSent then
@@ -390,7 +424,7 @@ begin
   EndRequest(ARequest,AResponse);
 end;
 
-constructor TCustomWebApplication.Create(AOwner: TComponent);
+constructor TWebHandler.Create(AOwner:TComponent);
 begin
   inherited Create(AOwner);
   FModuleVar:='Module'; // Do not localize
@@ -400,16 +434,169 @@ begin
   FRedirectOnErrorURL := '';
 end;
 
+{ TCustomWebApplication }
+
+function TCustomWebApplication.GetAdministrator: String;
+begin
+  result := FWebHandler.Administrator;
+end;
+
+function TCustomWebApplication.GetAllowDefaultModule: Boolean;
+begin
+  result := FWebHandler.AllowDefaultModule;
+end;
+
+function TCustomWebApplication.GetApplicationURL: String;
+begin
+  result := FWebHandler.ApplicationURL;
+end;
+
+function TCustomWebApplication.GetEmail: String;
+begin
+  result := FWebHandler.Email;
+end;
+
+function TCustomWebApplication.GetEventLog: TEventLog;
+begin
+  if not assigned(FEventLog) then
+    FEventLog := TEventLog.Create(self);
+  Result := FEventLog;
+end;
+
+function TCustomWebApplication.GetHandleGetOnPost: Boolean;
+begin
+  result := FWebHandler.HandleGetOnPost;
+end;
+
+function TCustomWebApplication.GetModuleVar: String;
+begin
+  result := FWebHandler.ModuleVariable;
+end;
+
+function TCustomWebApplication.GetOnGetModule: TGetModuleEvent;
+begin
+  result := FWebHandler.OnGetModule;
+end;
+
+function TCustomWebApplication.GetOnShowRequestException: TOnShowRequestException;
+begin
+  result := FWebHandler.OnShowRequestException;
+end;
+
+function TCustomWebApplication.GetRedirectOnError: boolean;
+begin
+  result := FWebHandler.RedirectOnError;
+end;
+
+function TCustomWebApplication.GetRedirectOnErrorURL: string;
+begin
+  result := FWebHandler.RedirectOnErrorURL;
+end;
+
+procedure TCustomWebApplication.SetAdministrator(const AValue: String);
+begin
+  FWebHandler.Administrator := AValue;
+end;
+
+procedure TCustomWebApplication.SetAllowDefaultModule(const AValue: Boolean);
+begin
+  FWebHandler.AllowDefaultModule := AValue;
+end;
+
+procedure TCustomWebApplication.SetApplicationURL(const AValue: String);
+begin
+  FWebHandler.ApplicationURL := AValue;
+end;
+
+procedure TCustomWebApplication.SetEmail(const AValue: String);
+begin
+  FWebHandler.Email := AValue;
+end;
+
+procedure TCustomWebApplication.SetHandleGetOnPost(const AValue: Boolean);
+begin
+  FWebHandler.HandleGetOnPost := AValue;
+end;
+
+procedure TCustomWebApplication.SetModuleVar(const AValue: String);
+begin
+  FWebHandler.ModuleVariable := AValue;
+end;
+
+procedure TCustomWebApplication.SetOnGetModule(const AValue: TGetModuleEvent);
+begin
+  FWebHandler.OnGetModule := AValue;
+end;
+
+procedure TCustomWebApplication.SetOnShowRequestException(const AValue: TOnShowRequestException);
+begin
+  FWebHandler.OnShowRequestException := AValue;
+end;
+
+procedure TCustomWebApplication.SetRedirectOnError(const AValue: boolean);
+begin
+  FWebHandler.RedirectOnError := AValue;
+end;
+
+procedure TCustomWebApplication.SetRedirectOnErrorURL(const AValue: string);
+begin
+  FWebHandler.RedirectOnErrorURL :=AValue;
+end;
+
+procedure TCustomWebApplication.DoRun;
+begin
+  FWebHandler.Run;
+end;
+
+procedure TCustomWebApplication.SetTitle(const AValue: string);
+begin
+  inherited SetTitle(AValue);
+  FWebHandler.Title := Title;
+end;
+
+constructor TCustomWebApplication.Create(AOwner: TComponent);
+begin
+  FWebHandler := InitializeWebHandler;
+  FWebHandler.FOnTerminate:=@DoOnTerminate;
+end;
+
+procedure TCustomWebApplication.DoOnTerminate(Sender : TObject);
+begin
+  If Not Terminated then
+    Terminate;
+end;
+
 destructor TCustomWebApplication.Destroy;
 begin
+  FWebHandler.Free;
   if assigned(FEventLog) then
     FEventLog.Free;
-  inherited Destroy;
 end;
 
 procedure TCustomWebApplication.CreateForm(AClass: TComponentClass; out Reference);
 begin
-  TComponent(Reference):=AClass.Create(Self);
+  TComponent(Reference):=AClass.Create(FWebHandler);
+end;
+
+procedure TCustomWebApplication.Initialize;
+begin
+  StopOnException:=True;
+  Inherited;
 end;
 
+procedure TCustomWebApplication.Log(EventType: TEventType; const Msg: String);
+begin
+  EventLog.log(EventType,Msg);
+end;
+
+Procedure TCustomWebApplication.Terminate;
+
+begin
+  Inherited;
+  If Not Webhandler.FTerminated then
+    WebHandler.Terminate;
+end;
+
+
 end.
+

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

@@ -54,7 +54,7 @@ uses
 {$IFDEF CGIGDEBUG}
   dbugintf,
 {$endif}
-  Classes, SysUtils,httpDefs,custcgi,fastcgi,ssockets,inifiles;
+  Classes, SysUtils,httpDefs,custcgi,fastcgi,ssockets,inifiles,custweb;
 
 Type
 
@@ -67,7 +67,9 @@ Type
 
   { TFastCGIGatewayApplication }
 
-  TFastCGIGatewayApplication = Class(TCustomCGIApplication)
+  { TFastCGIGatewayHandler }
+
+  TFastCGIGatewayHandler = Class(TCgiHandler)
   private
     FConfigFile: String;
     FFastCGIBinary: String;
@@ -123,7 +125,7 @@ Type
     Constructor Create(AOwner : TComponent); override;
     Destructor Destroy; override;
     Procedure HandleRequest(ARequest : Trequest; AResponse : TResponse); override;
-    Procedure Initialize; override;
+    Procedure Initialize;
     Property ConfigFileName : String Read FConfigFile Write SetConfigFile;
     Property FastCGIBinary : String Read FFastCGIBinary Write FFastCGIBinary;
     Property HostName : String Read FHostName Write SetHostname;
@@ -132,6 +134,13 @@ Type
     Property Environment : TStrings Read FEnvironment Write SetEnvironment;
   end;
 
+  TFastCGIGatewayApplication = Class(TCustomCGIApplication)
+  protected
+    function InitializeWebHandler: TWebHandler; override;
+  public
+    Procedure Initialize; override;
+  end;
+
 Resourcestring
   SErrCouldNotConnectToFCGI = 'Could not connect to FastCGI server.';
   SErrNoConnectionData      = 'No FastCGI connection data available.';
@@ -157,51 +166,51 @@ implementation
 
 { TCGIGateWayResponse }
 
-procedure TCGIGateWayResponse.DoSendHeaders(Headers: TStrings);
+procedure TCGIGatewayResponse.DoSendHeaders(Headers: TStrings);
 
 begin
   // Do nothing. Headers are in response from FastCGI and are sent as content;
 end;
 
-procedure TFastCGIGatewayApplication.SetConfigFile(const AValue: String);
+procedure TFastCGIGatewayHandler.SetConfigFile(const AValue: String);
 begin
   if FConfigFile=AValue then exit;
   CheckInitDone;
   FConfigFile:=AValue;
 end;
 
-procedure TFastCGIGatewayApplication.SetEnvironment(const AValue: TStrings);
+procedure TFastCGIGatewayHandler.SetEnvironment(const AValue: TStrings);
 begin
   FEnvironment.Assign(AValue);
 end;
 
-procedure TFastCGIGatewayApplication.SetHostname(const AValue: String);
+procedure TFastCGIGatewayHandler.SetHostname(const AValue: String);
 begin
   if FHostName=AValue then exit;
   CheckInitDone;
   FHostName:=AValue;
 end;
 
-procedure TFastCGIGatewayApplication.CheckInitDone;
+procedure TFastCGIGatewayHandler.CheckInitDone;
 begin
   If FInitDone then
     RaiseError(SErrInitDone);
 end;
 
-function TFastCGIGatewayApplication.CreateResponse(AOutput: TStream): TCGIResponse;
+function TFastCGIGatewayHandler.CreateResponse(AOutput: TStream): TCGIResponse;
 begin
 {$IFDEF CGIGDEBUG}SendMethodEnter('CreateResponse');{$ENDIF}
   Result:=TCGIGatewayResponse.CreateCGI(Self,AOutput);
 {$IFDEF CGIGDEBUG}SendMethodExit('CreateResponse');{$ENDIF}
 end;
 
-Procedure TFastCGIGatewayApplication.StartFCGIBinary;
+Procedure TFastCGIGatewayHandler.StartFCGIBinary;
 
 begin
   ExecuteProcess(FastCGIBinary,'',[]);
 end;
 
-Procedure TFastCGIGatewayApplication.ConnectToFCGI;
+Procedure TFastCGIGatewayHandler.ConnectToFCGI;
 
 begin
   try
@@ -237,7 +246,7 @@ begin
       Result:=Result+Format('#%.3d',[Ord(S[i])]);
 end;
 
-Function TFastCGIGatewayApplication.EncodeFastCGIParam(N,V : AnsiString) : String;
+Function TFastCGIGatewayHandler.EncodeFastCGIParam(N,V : AnsiString) : String;
 
   Function CalcJump(ALen : Integer) : Integer;
   begin
@@ -291,19 +300,19 @@ begin
 {$IFDEF CGIGDEBUG}SendMethodExit('EncodeFastCGIParam');{$ENDIF}
 end;
 
-constructor TFastCGIGatewayApplication.Create(AOwner: TComponent);
+constructor TFastCGIGatewayHandler.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
   FEnvironment:=TStringList.Create;
 end;
 
-destructor TFastCGIGatewayApplication.Destroy;
+destructor TFastCGIGatewayHandler.Destroy;
 begin
   FreeAndNil(FEnvironment);
   inherited Destroy;
 end;
 
-Function TFastCGIGatewayApplication.TransformRequestVars : String;
+Function TFastCGIGatewayHandler.TransformRequestVars : String;
 
 Var
   L : TStringList;
@@ -328,7 +337,7 @@ begin
   end;
 end;
 
-Procedure TFastCGIGatewayApplication.SendFastCGIRecord(P : PFCGI_Header);
+Procedure TFastCGIGatewayHandler.SendFastCGIRecord(P : PFCGI_Header);
 
 Var
   Len : Integer;
@@ -341,7 +350,7 @@ begin
 end;
 
 
-Procedure TFastCGIGatewayApplication.InitFastCGIRecord(P : PFCGI_Header; Const AContentLength, APadLength : Word);
+Procedure TFastCGIGatewayHandler.InitFastCGIRecord(P : PFCGI_Header; Const AContentLength, APadLength : Word);
 
 begin
 {$IFDEF CGIGDEBUG}SendMethodEnter('InitFastCGIRecord');{$ENDIF}
@@ -353,7 +362,7 @@ begin
 {$IFDEF CGIGDEBUG}SendMethodExit('InitFastCGIRecord');{$ENDIF}
 end;
 
-function TFastCGIGatewayApplication.CreateFastCGIRecord(const AContentLength: Word) : PFCGI_Header;
+function TFastCGIGatewayHandler.CreateFastCGIRecord(const AContentLength: Word) : PFCGI_Header;
 
 Var
   L,PL : INteger;
@@ -370,7 +379,7 @@ begin
 {$IFDEF CGIGDEBUG}SendMethodExit('CreateFastCGIRecord');{$ENDIF}
 end;
 
-Procedure TFastCGIGatewayApplication.SendBeginRequest;
+Procedure TFastCGIGatewayHandler.SendBeginRequest;
 
 Var
   Req : FCGI_BeginRequestRecord;
@@ -386,7 +395,7 @@ begin
 end;
 
 
-Procedure TFastCGIGatewayApplication.SendRequestData(Const ARequest : Trequest);
+Procedure TFastCGIGatewayHandler.SendRequestData(Const ARequest : Trequest);
 
   Procedure SendString(S : String; RecType : Byte);
 
@@ -429,7 +438,7 @@ begin
 {$IFDEF CGIGDEBUG}SendMethodExit('SendRequestData');{$ENDIF}
 end;
 
-Function TFastCGIGatewayApplication.ReadFastCGIRecord : PFCGI_Header;
+Function TFastCGIGatewayHandler.ReadFastCGIRecord : PFCGI_Header;
 
 var
   Header : FCGI_Header;
@@ -468,7 +477,7 @@ begin
 {$IFDEF CGIGDEBUG}SendMethodExit('ReadFastCGIRecord');{$ENDIF}
 end;
 
-Procedure TFastCGIGatewayApplication.ProcessUnknownRecord(Const Rec : PFCGI_Header; Const AResponse : TResponse; Var EOR : Boolean);
+Procedure TFastCGIGatewayHandler.ProcessUnknownRecord(Const Rec : PFCGI_Header; Const AResponse : TResponse; Var EOR : Boolean);
 
 begin
 {$IFDEF CGIGDEBUG}SendMethodEnter('ProcessUnknownRecord');{$ENDIF}
@@ -477,7 +486,7 @@ begin
 {$IFDEF CGIGDEBUG}SendMethodEnter('ProcessUnknownRecord');{$ENDIF}
 end;
 
-Procedure TFastCGIGatewayApplication.ReadResponse(AResponse : TResponse);
+Procedure TFastCGIGatewayHandler.ReadResponse(AResponse : TResponse);
 
 Var
   Rec : PFCGI_Header;
@@ -518,7 +527,7 @@ begin
 {$IFDEF CGIGDEBUG}SendMethodExit('ReadResponse');{$ENDIF}
 end;
 
-Procedure TFastCGIGatewayApplication.DisconnectfromFCGI;
+Procedure TFastCGIGatewayHandler.DisconnectfromFCGI;
 
 begin
 {$IFDEF CGIGDEBUG}SendMethodEnter('DisconnectfromFCGI');{$ENDIF}
@@ -526,7 +535,7 @@ begin
 {$IFDEF CGIGDEBUG}SendMethodExit('DisconnectfromFCGI');{$ENDIF}
 end;
 
-Procedure TFastCGIGatewayApplication.HandleRequest(ARequest : Trequest; AResponse : TResponse);
+Procedure TFastCGIGatewayHandler.HandleRequest(ARequest : Trequest; AResponse : TResponse);
 
 begin
 {$IFDEF CGIGDEBUG}SendMethodEnter('Handle request');{$ENDIF}
@@ -541,15 +550,32 @@ begin
 {$IFDEF CGIGDEBUG}SendMethodExit('Handle request');{$ENDIF}
 end;
 
-procedure TFastCGIGatewayApplication.RaiseError(Const Msg : String);
+procedure TFastCGIGatewayHandler.Initialize;
+Var
+  Ini : TIniFile;
+begin
+  If (FConfigFile<>'') and FileExists(FConfigFile) then
+    begin
+    Ini:=TIniFile.Create(FConfigFile);
+    try
+      ReadConfigFile(Ini);
+    finally
+      Ini.Free;
+    end;
+    end;
+  if (Hostname='') or (Port=0) then
+    RaiseError(SErrNoConnectionData);
+  FInitDone:=True;
+end;
+
+procedure TFastCGIGatewayHandler.RaiseError(Const Msg : String);
 
 begin
   Raise HTTPError.Create(Msg);
 end;
 
 
-procedure TFastCGIGatewayApplication.ReadConfigFile(Ini : TIniFile);
-
+procedure TFastCGIGatewayHandler.ReadConfigFile(Ini : TIniFile);
 begin
   With Ini do
     begin
@@ -564,28 +590,18 @@ begin
 end;
 
 procedure TFastCGIGatewayApplication.Initialize;
-
-Var
-  Ini : TIniFile;
-
 begin
 {$IFDEF CGIGDEBUG}SendMethodEnter('Initialize');{$ENDIF}
   inherited Initialize;
-  If (FConfigFile<>'') and FileExists(FConfigFile) then
-    begin
-    Ini:=TIniFile.Create(FConfigFile);
-    try
-      ReadConfigFile(Ini);
-    finally
-      Ini.Free;
-    end;
-    end;
-  if (Hostname='') or (Port=0) then
-    RaiseError(SErrNoConnectionData);
-  FInitDone:=True;
+  TFastCGIGatewayHandler(WebHandler).Initialize;
 {$IFDEF CGIGDEBUG}SendMethodExit('Initialize');{$ENDIF}
 end;
 
+function TFastCGIGatewayApplication.InitializeWebHandler: TWebHandler;
+begin
+  Result:=TFastCGIGatewayHandler.Create(self);
+end;
+
 Procedure InitCGIGateWay; // Initializes Application.
 
 begin

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

@@ -22,29 +22,29 @@ uses
 
 Type
 
-  TCustomApacheApplication = Class;
+  TApacheHandler = Class;
 
   { TApacheRequest }
 
   TApacheRequest = Class(TRequest)
   Private
-    FApache : TCustomApacheApplication;
+    FApache : TApacheHandler;
     FRequest : PRequest_rec;
   Protected
     Function GetFieldValue(Index : Integer) : String; override;
     Procedure InitFromRequest;
     procedure ReadContent; override;
   Public
-    Constructor CreateReq(App : TCustomApacheApplication; ARequest : PRequest_rec);
+    Constructor CreateReq(App : TApacheHandler; ARequest : PRequest_rec);
     Property ApacheRequest : Prequest_rec Read FRequest;
-    Property ApacheApp : TCustomApacheApplication Read FApache;
+    Property ApacheApp : TApacheHandler Read FApache;
   end;
 
   { TApacheResponse }
 
   TApacheResponse = Class(TResponse)
   private
-    FApache : TCustomApacheApplication;
+    FApache : TApacheHandler;
     FRequest : PRequest_rec;
     procedure SendStream(S: TStream);
   Protected
@@ -53,7 +53,7 @@ Type
   Public
     Constructor CreateApache(Req : TApacheRequest);
     Property ApacheRequest : Prequest_rec Read FRequest;
-    Property ApacheApp : TCustomApacheApplication Read FApache;
+    Property ApacheApp : TApacheHandler Read FApache;
   end;
 
   { TCustomApacheApplication }
@@ -61,7 +61,7 @@ Type
   TBeforeRequestEvent = Procedure(Sender : TObject; Const AHandler : String;
                                   Var AllowRequest : Boolean) of object;
 
-  TCustomApacheApplication = Class(TCustomWebApplication)
+  TApacheHandler = Class(TWebHandler)
   private
     FMaxRequests: Integer;             //Maximum number of simultaneous web module requests (default=64, if set to zero no limit)
     FWorkingWebModules: TList;         //List of currently running web modules handling requests
@@ -80,16 +80,15 @@ Type
     function GetWorkingModuleCount : Integer;
   Protected
     Function ProcessRequest(P : PRequest_Rec) : Integer; virtual;
-    Procedure DoRun; override;
     function WaitForRequest(out ARequest : TRequest; out AResponse : TResponse) : boolean; override;
     Function AllowRequest(P : PRequest_Rec) : Boolean; virtual;
     function GetApplicationURL(ARequest : TRequest): String; override;
   Public
     Constructor Create(AOwner : TComponent); override;
     Destructor Destroy; override;
+    Procedure Run; override;
     Procedure SetModuleRecord(Var ModuleRecord : Module);
-    Procedure Initialize; override;
-    Procedure ShowException(E : Exception); override;
+    Procedure Initialize;
     Procedure LogErrorMessage(Msg : String; LogLevel : integer = APLOG_INFO); virtual;
     Procedure handleRequest(ARequest : TRequest; AResponse : TResponse); override;
     Property HandlerPriority : THandlerPriority Read FPriority Write FPriority default hpMiddle;
@@ -104,6 +103,43 @@ Type
     Property WorkingWebModuleCount: Integer read GetWorkingModuleCount;
   end;
 
+  TCustomApacheApplication = Class(TCustomWebApplication)
+  private
+    function GetAfterModules: TStrings;
+    function GetBaseLocation: String;
+    function GetBeforeModules: TStrings;
+    function GetBeforeRequest: TBeforeRequestEvent;
+    function GetHandlerName: String;
+    function GetIdleModuleCount: Integer;
+    function GetMaxRequests: Integer;
+    function GetModuleName: String;
+    function GetPriority: THandlerPriority;
+    function GetWorkingModuleCount: Integer;
+    procedure SetAfterModules(const AValue: TStrings);
+    procedure SetBaseLocation(const AValue: String);
+    procedure SetBeforeModules(const AValue: TStrings);
+    procedure SetBeforeRequest(const AValue: TBeforeRequestEvent);
+    procedure SetHandlerName(const AValue: String);
+    procedure SetMaxRequests(const AValue: Integer);
+    procedure SetModuleName(const AValue: String);
+    procedure SetPriority(const AValue: THandlerPriority);
+  public
+    function InitializeWebHandler: TWebHandler; override;
+    procedure ShowException(E: Exception); override;
+    Function ProcessRequest(P : PRequest_Rec) : Integer; virtual;
+    Function AllowRequest(P : PRequest_Rec) : Boolean; virtual;
+    Property HandlerPriority : THandlerPriority Read GetPriority Write SetPriority default hpMiddle;
+    Property BeforeModules : TStrings Read GetBeforeModules Write SetBeforeModules;
+    Property AfterModules : TStrings Read GetAfterModules Write SetAfterModules;
+    Property BaseLocation : String Read GetBaseLocation Write SetBaseLocation;
+    Property ModuleName : String Read GetModuleName Write SetModuleName;
+    Property HandlerName : String Read GetHandlerName Write SetHandlerName;
+    Property BeforeRequest : TBeforeRequestEvent Read GetBeforeRequest Write SetBeforeRequest;
+    Property MaxRequests: Integer read GetMaxRequests write SetMaxRequests;
+    Property IdleWebModuleCount: Integer read GetIdleModuleCount;
+    Property WorkingWebModuleCount: Integer read GetWorkingModuleCount;
+  end;
+
   TApacheApplication = Class(TCustomApacheApplication)
   Public
     Property HandlerPriority;
@@ -128,6 +164,8 @@ Var
 
 Implementation
 
+uses CustApp;
+
 resourcestring
   SErrNoModuleNameForRequest = 'Could not determine HTTP module name for request';
   SErrNoModuleForRequest = 'Could not determine HTTP module for request "%s"';
@@ -144,12 +182,16 @@ Procedure InitApache;
 
 begin
   Application:=TCustomApacheApplication.Create(Nil);
+  if not assigned(CustomApplication) then
+    CustomApplication := Application;
 end;
 
 Procedure DoneApache;
 
 begin
   Try
+    if CustomApplication=Application then
+      CustomApplication := nil;
     FreeAndNil(Application);
   except
     if ShowCleanUpErrors then
@@ -184,16 +226,16 @@ begin
   ap_hook_handler(H,PP1,PP2,HPRIO[Application.HandlerPriority]);
 end;
 
-{ TCustomApacheApplication }
+{ TApacheHandler }
 
-function TCustomApacheApplication.GetModules(Index: integer): TStrings;
+function TApacheHandler.GetModules(Index: integer): TStrings;
 begin
   If (FModules[Index]=Nil) then
     FModules[Index]:=TStringList.Create;
   Result:=FModules[Index];
 end;
 
-procedure TCustomApacheApplication.SetModules(Index: integer;
+procedure TApacheHandler.SetModules(Index: integer;
   const AValue: TStrings);
 begin
   If (FModules[Index]=Nil) then
@@ -201,7 +243,7 @@ begin
   FModules[Index].Assign(AValue);
 end;
 
-Function TCustomApacheApplication.ProcessRequest(P: PRequest_Rec) : Integer;
+Function TApacheHandler.ProcessRequest(P: PRequest_Rec) : Integer;
 
 Var
   Req : TApacheRequest;
@@ -225,18 +267,18 @@ begin
   end;
 end;
 
-procedure TCustomApacheApplication.DoRun;
+procedure TApacheHandler.Run;
 begin
   // Do nothing. This is a library
+  Initialize;
 end;
 
-function TCustomApacheApplication.WaitForRequest(out ARequest: TRequest;
-  out AResponse: TResponse): boolean;
+function TApacheHandler.WaitForRequest(out ARequest: TRequest; out AResponse: TResponse): boolean;
 begin
   // Do nothing. Requests are triggered by Apache
 end;
 
-function TCustomApacheApplication.AllowRequest(P: PRequest_Rec): Boolean;
+function TApacheHandler.AllowRequest(P: PRequest_Rec): Boolean;
 
 Var
   Hn : String;
@@ -248,15 +290,14 @@ begin
     FBeforeRequest(Self,HN,Result);
 end;
 
-function TCustomApacheApplication.GetApplicationURL(ARequest: TRequest
-  ): String;
+function TApacheHandler.GetApplicationURL(ARequest: TRequest): String;
 begin
   Result:=inherited GetApplicationURL(ARequest);
   If (Result='') then
     Result:=BaseLocation;
 end;
 
-constructor TCustomApacheApplication.Create(AOwner: TComponent);
+constructor TApacheHandler.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
   FPriority:=hpMiddle;
@@ -266,7 +307,7 @@ begin
   FCriticalSection:=TCriticalSection.Create;
 end;
 
-destructor TCustomApacheApplication.Destroy;
+destructor TApacheHandler.Destroy;
 var I:Integer;
 begin
   FCriticalSection.Free;
@@ -280,13 +321,13 @@ begin
 end;
 
 
-procedure TCustomApacheApplication.SetModuleRecord(var ModuleRecord: Module);
+procedure TApacheHandler.SetModuleRecord(var ModuleRecord: Module);
 begin
   FModuleRecord:=@ModuleRecord;
   FillChar(ModuleRecord,SizeOf(ModuleRecord),0);
 end;
 
-procedure TCustomApacheApplication.Initialize;
+procedure TApacheHandler.Initialize;
 
 begin
   If (FModuleRecord=nil) then
@@ -299,18 +340,12 @@ begin
   FModuleRecord^.register_hooks:=@RegisterApacheHooks;
 end;
 
-procedure TCustomApacheApplication.ShowException(E: Exception);
-begin
-  ap_log_error(pchar(FModuleName),0,APLOG_ERR,0,Nil,'module: %s',[Pchar(E.Message)]);
-end;
-
-procedure TCustomApacheApplication.LogErrorMessage(Msg: String;
-  LogLevel: integer);
+procedure TApacheHandler.LogErrorMessage(Msg: String; LogLevel: integer);
 begin
   ap_log_error(pchar(FModuleName),0,LogLevel,0,Nil,'module: %s',[pchar(Msg)]);
 end;
 
-function TCustomApacheApplication.GetIdleModuleCount : Integer;
+function TApacheHandler.GetIdleModuleCount : Integer;
 begin
   FCriticalSection.Enter;
   try
@@ -320,7 +355,7 @@ begin
   end;
 end;
 
-function TCustomApacheApplication.GetWorkingModuleCount : Integer;
+function TApacheHandler.GetWorkingModuleCount : Integer;
 begin
   FCriticalSection.Enter;
   try
@@ -330,7 +365,7 @@ begin
   end;
 end;
 
-procedure TCustomApacheApplication.HandleRequest(ARequest: TRequest; AResponse: TResponse);
+procedure TApacheHandler.HandleRequest(ARequest: TRequest; AResponse: TResponse);
 
 Var
   MC : TCustomHTTPModuleClass;
@@ -399,7 +434,7 @@ begin
   except
     On E : Exception do
       begin
-      ShowException(E);
+      LogErrorMessage(E.Message,APLOG_ERR);
       ShowRequestException(AResponse,E);
       end;
   end;
@@ -497,7 +532,7 @@ begin
   ParseCookies;
 end;
 
-Constructor TApacheRequest.CreateReq(App : TCustomApacheApplication; ARequest : PRequest_rec);
+Constructor TApacheRequest.CreateReq(App : TApacheHandler; ARequest : PRequest_rec);
 
 begin
   FApache:=App;
@@ -584,6 +619,118 @@ begin
 //empty
 end;
 
+{ TCustomApacheApplication }
+
+function TCustomApacheApplication.GetAfterModules: TStrings;
+begin
+  result := TApacheHandler(WebHandler).AfterModules;
+end;
+
+function TCustomApacheApplication.GetBaseLocation: String;
+begin
+  result := TApacheHandler(WebHandler).BaseLocation;
+end;
+
+function TCustomApacheApplication.GetBeforeModules: TStrings;
+begin
+  result := TApacheHandler(WebHandler).BeforeModules;
+end;
+
+function TCustomApacheApplication.GetBeforeRequest: TBeforeRequestEvent;
+begin
+  result := TApacheHandler(WebHandler).BeforeRequest;
+end;
+
+function TCustomApacheApplication.GetHandlerName: String;
+begin
+  result := TApacheHandler(WebHandler).HandlerName;
+end;
+
+function TCustomApacheApplication.GetIdleModuleCount: Integer;
+begin
+  result := TApacheHandler(WebHandler).IdleWebModuleCount;
+end;
+
+function TCustomApacheApplication.GetMaxRequests: Integer;
+begin
+  result := TApacheHandler(WebHandler).MaxRequests;
+end;
+
+function TCustomApacheApplication.GetModuleName: String;
+begin
+  result := TApacheHandler(WebHandler).ModuleName;
+end;
+
+function TCustomApacheApplication.GetPriority: THandlerPriority;
+begin
+  result := TApacheHandler(WebHandler).HandlerPriority;
+end;
+
+function TCustomApacheApplication.GetWorkingModuleCount: Integer;
+begin
+  result := TApacheHandler(WebHandler).WorkingWebModuleCount;
+end;
+
+procedure TCustomApacheApplication.SetAfterModules(const AValue: TStrings);
+begin
+  TApacheHandler(WebHandler).AfterModules := AValue;
+end;
+
+procedure TCustomApacheApplication.SetBaseLocation(const AValue: String);
+begin
+  TApacheHandler(WebHandler).BaseLocation := AValue;
+end;
+
+procedure TCustomApacheApplication.SetBeforeModules(const AValue: TStrings);
+begin
+  TApacheHandler(WebHandler).BeforeModules := AValue;
+end;
+
+procedure TCustomApacheApplication.SetBeforeRequest(const AValue: TBeforeRequestEvent);
+begin
+  TApacheHandler(WebHandler).BeforeRequest := AValue;
+end;
+
+procedure TCustomApacheApplication.SetHandlerName(const AValue: String);
+begin
+  TApacheHandler(WebHandler).HandlerName := AValue;
+end;
+
+procedure TCustomApacheApplication.SetMaxRequests(const AValue: Integer);
+begin
+  TApacheHandler(WebHandler).MaxRequests := AValue;
+end;
+
+procedure TCustomApacheApplication.SetModuleName(const AValue: String);
+begin
+  TApacheHandler(WebHandler).ModuleName := AValue;
+end;
+
+procedure TCustomApacheApplication.SetPriority(const AValue: THandlerPriority);
+begin
+  TApacheHandler(WebHandler).HandlerPriority := AValue;
+end;
+
+function TCustomApacheApplication.InitializeWebHandler: TWebHandler;
+begin
+  Result:=TApacheHandler.Create(self);
+end;
+
+procedure TCustomApacheApplication.ShowException(E: Exception);
+begin
+  ap_log_error(pchar(TApacheHandler(WebHandler).ModuleName),0,APLOG_ERR,0,Nil,'module: %s',[Pchar(E.Message)]);
+end;
+
+function TCustomApacheApplication.ProcessRequest(P: PRequest_Rec): Integer;
+begin
+  result := TApacheHandler(WebHandler).ProcessRequest(p);
+end;
+
+function TCustomApacheApplication.AllowRequest(P: PRequest_Rec): Boolean;
+begin
+  result := TApacheHandler(WebHandler).AllowRequest(p);
+end;
+
 Initialization
   BeginThread(@__dummythread);//crash prevention for simultaneous requests
   sleep(300);

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

@@ -38,13 +38,16 @@ Procedure InitCGI;
 
 begin
   Application:=TCGIApplication.Create(Nil);
-  CustomApplication:=Application;
+  if not assigned(CustomApplication) then
+    CustomApplication := Application;
 end;
 
 Procedure DoneCGI;
 
 begin
   Try
+    if CustomApplication=Application then
+      CustomApplication := nil;
     FreeAndNil(Application);
   except
     if ShowCleanUpErrors then

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

@@ -31,16 +31,22 @@ Var
   
 Implementation
 
+uses CustApp;
+
 Procedure InitFCGI;
 
 begin
   Application:=TFCGIApplication.Create(Nil);
+  if not assigned(CustomApplication) then
+    CustomApplication := Application;
 end;
 
 Procedure DoneFCGI;
 
 begin
   Try
+    if CustomApplication=Application then
+      CustomApplication := nil;
     FreeAndNil(Application);
   except
     if ShowCleanUpErrors then

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

@@ -283,8 +283,12 @@ begin
   If FSessionStarted then
     begin
 {$ifdef cgidebug}SendDebug('Session started');{$endif}
-    C:=AResponse.Cookies.Add;
-    C.Name:=SessionCookie;
+    C:=AResponse.Cookies.FindCookie(SessionCookie);
+    If (C=Nil) then
+      begin
+      C:=AResponse.Cookies.Add;
+      C.Name:=SessionCookie;
+      end;
     C.Value:=SID;
     C.Path:=FSessionCookiePath;
     end
@@ -350,8 +354,8 @@ begin
     begin
     If (FSession=Nil) then
       FSession:=GetDefaultSession;
-    if Assigned(Session) then
-      Session.InitSession(ARequest,FOnNewSession,FOnSessionExpired);
+    if Assigned(FSession) then
+      FSession.InitSession(ARequest,FOnNewSession,FOnSessionExpired);
     end;
 {$ifdef cgidebug}SendMethodExit('SessionHTTPModule('+Name+').CheckSession');{$endif}
 end;

packages/fcl-web/src/jsonrpc/Makefile

@@ -4,7 +4,7 @@
 default: all
 MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-solaris x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded avr-embedded armeb-linux armeb-embedded mipsel-linux
 BSDs = freebsd netbsd openbsd darwin
-UNIXs = linux $(BSDs) solaris qnx haiku
+UNIXs = linux $(BSDs) solaris qnx
 LIMIT83fs = go32v2 os2 emx watcom
 OSNeedsComspecToRunBatch = go32v2 watcom
 FORCE:
@@ -59,11 +59,9 @@ endif
 endif
 ifdef COMSPEC
 ifneq ($(findstring $(OS_SOURCE),$(OSNeedsComspecToRunBatch)),)
-ifndef RUNBATCH
 RUNBATCH=$(COMSPEC) /C
 endif
 endif
-endif
 ifdef inUnix
 PATHSEP=/
 else
@@ -390,9 +388,6 @@ endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
 override TARGET_UNITS+=fpjsonrpc  webjsonrpc fpextdirect
 endif
-ifeq ($(FULL_TARGET),x86_64-solaris)
-override TARGET_UNITS+=fpjsonrpc  webjsonrpc fpextdirect
-endif
 ifeq ($(FULL_TARGET),x86_64-darwin)
 override TARGET_UNITS+=fpjsonrpc  webjsonrpc fpextdirect
 endif
@@ -444,9 +439,6 @@ endif
 ifeq ($(FULL_TARGET),armeb-embedded)
 override TARGET_UNITS+=fpjsonrpc  webjsonrpc fpextdirect
 endif
-ifeq ($(FULL_TARGET),mipsel-linux)
-override TARGET_UNITS+=fpjsonrpc  webjsonrpc fpextdirect
-endif
 override INSTALL_FPCPACKAGE=y
 ifeq ($(FULL_TARGET),i386-linux)
 override COMPILER_OPTIONS+=-S2h
@@ -571,9 +563,6 @@ endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
 override COMPILER_OPTIONS+=-S2h
 endif
-ifeq ($(FULL_TARGET),x86_64-solaris)
-override COMPILER_OPTIONS+=-S2h
-endif
 ifeq ($(FULL_TARGET),x86_64-darwin)
 override COMPILER_OPTIONS+=-S2h
 endif
@@ -625,9 +614,6 @@ endif
 ifeq ($(FULL_TARGET),armeb-embedded)
 override COMPILER_OPTIONS+=-S2h
 endif
-ifeq ($(FULL_TARGET),mipsel-linux)
-override COMPILER_OPTIONS+=-S2h
-endif
 ifdef REQUIRE_UNITSDIR
 override UNITSDIR+=$(REQUIRE_UNITSDIR)
 endif
@@ -1425,31 +1411,35 @@ else
 TAROPT=vz
 TAREXT=.tar.gz
 endif
-override REQUIRE_PACKAGES=rtl fcl-base fcl-xml fcl-json
+override REQUIRE_PACKAGES=rtl fcl-base fcl-xml fcl-json fcl-process
 ifeq ($(FULL_TARGET),i386-linux)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_ICONVENC=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),i386-go32v2)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),i386-win32)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),i386-os2)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),i386-freebsd)
 REQUIRE_PACKAGES_RTL=1
@@ -1457,6 +1447,7 @@ REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_ICONVENC=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),i386-beos)
 REQUIRE_PACKAGES_RTL=1
@@ -1464,6 +1455,7 @@ REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_ICONVENC=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),i386-haiku)
 REQUIRE_PACKAGES_RTL=1
@@ -1471,42 +1463,49 @@ REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_ICONVENC=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),i386-netbsd)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),i386-solaris)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),i386-qnx)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),i386-netware)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),i386-openbsd)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),i386-wdosx)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),i386-darwin)
 REQUIRE_PACKAGES_RTL=1
@@ -1515,42 +1514,49 @@ REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_ICONVENC=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),i386-emx)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),i386-watcom)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),i386-netwlibc)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),i386-wince)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),i386-embedded)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),i386-symbian)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),m68k-linux)
 REQUIRE_PACKAGES_RTL=1
@@ -1558,6 +1564,7 @@ REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_ICONVENC=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),m68k-freebsd)
 REQUIRE_PACKAGES_RTL=1
@@ -1565,42 +1572,49 @@ REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_ICONVENC=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),m68k-netbsd)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),m68k-amiga)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),m68k-atari)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),m68k-openbsd)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),m68k-palmos)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),m68k-embedded)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),powerpc-linux)
 REQUIRE_PACKAGES_RTL=1
@@ -1608,24 +1622,28 @@ REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_ICONVENC=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),powerpc-netbsd)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),powerpc-amiga)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),powerpc-macos)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),powerpc-darwin)
 REQUIRE_PACKAGES_RTL=1
@@ -1634,18 +1652,21 @@ REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_ICONVENC=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),powerpc-morphos)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),powerpc-embedded)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),sparc-linux)
 REQUIRE_PACKAGES_RTL=1
@@ -1653,24 +1674,28 @@ REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_ICONVENC=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),sparc-netbsd)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),sparc-solaris)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),sparc-embedded)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),x86_64-linux)
 REQUIRE_PACKAGES_RTL=1
@@ -1678,6 +1703,7 @@ REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_ICONVENC=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
 REQUIRE_PACKAGES_RTL=1
@@ -1685,12 +1711,7 @@ REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_ICONVENC=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
-endif
-ifeq ($(FULL_TARGET),x86_64-solaris)
-REQUIRE_PACKAGES_RTL=1
-REQUIRE_PACKAGES_FCL-BASE=1
-REQUIRE_PACKAGES_FCL-XML=1
-REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),x86_64-darwin)
 REQUIRE_PACKAGES_RTL=1
@@ -1699,18 +1720,21 @@ REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_ICONVENC=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),x86_64-win64)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),x86_64-embedded)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),arm-linux)
 REQUIRE_PACKAGES_RTL=1
@@ -1718,12 +1742,14 @@ REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_ICONVENC=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),arm-palmos)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),arm-darwin)
 REQUIRE_PACKAGES_RTL=1
@@ -1732,36 +1758,42 @@ REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_ICONVENC=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),arm-wince)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),arm-gba)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),arm-nds)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),arm-embedded)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),arm-symbian)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),powerpc64-linux)
 REQUIRE_PACKAGES_RTL=1
@@ -1769,6 +1801,7 @@ REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_ICONVENC=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),powerpc64-darwin)
 REQUIRE_PACKAGES_RTL=1
@@ -1777,18 +1810,21 @@ REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_ICONVENC=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),powerpc64-embedded)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),avr-embedded)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),armeb-linux)
 REQUIRE_PACKAGES_RTL=1
@@ -1796,19 +1832,14 @@ REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_ICONVENC=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifeq ($(FULL_TARGET),armeb-embedded)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_FCL-JSON=1
-endif
-ifeq ($(FULL_TARGET),mipsel-linux)
-REQUIRE_PACKAGES_RTL=1
-REQUIRE_PACKAGES_FCL-BASE=1
-REQUIRE_PACKAGES_ICONVENC=1
-REQUIRE_PACKAGES_FCL-XML=1
-REQUIRE_PACKAGES_FCL-JSON=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
 endif
 ifdef REQUIRE_PACKAGES_RTL
 PACKAGEDIR_RTL:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR))))))
@@ -1819,9 +1850,9 @@ else
 UNITDIR_RTL=$(PACKAGEDIR_RTL)
 endif
 ifdef CHECKDEPEND
-$(PACKAGEDIR_RTL)/$(OS_TARGET)/$(FPCMADE):
-	$(MAKE) -C $(PACKAGEDIR_RTL)/$(OS_TARGET) $(FPCMADE)
-override ALLDEPENDENCIES+=$(PACKAGEDIR_RTL)/$(OS_TARGET)/$(FPCMADE)
+$(PACKAGEDIR_RTL)/$(FPCMADE):
+	$(MAKE) -C $(PACKAGEDIR_RTL) $(FPCMADE)
+override ALLDEPENDENCIES+=$(PACKAGEDIR_RTL)/$(FPCMADE)
 endif
 else
 PACKAGEDIR_RTL=
@@ -1940,6 +1971,32 @@ ifdef UNITDIR_FCL-JSON
 override COMPILER_UNITDIR+=$(UNITDIR_FCL-JSON)
 endif
 endif
+ifdef REQUIRE_PACKAGES_FCL-PROCESS
+PACKAGEDIR_FCL-PROCESS:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /fcl-process/Makefile.fpc,$(PACKAGESDIR))))))
+ifneq ($(PACKAGEDIR_FCL-PROCESS),)
+ifneq ($(wildcard $(PACKAGEDIR_FCL-PROCESS)/units/$(TARGETSUFFIX)),)
+UNITDIR_FCL-PROCESS=$(PACKAGEDIR_FCL-PROCESS)/units/$(TARGETSUFFIX)
+else
+UNITDIR_FCL-PROCESS=$(PACKAGEDIR_FCL-PROCESS)
+endif
+ifdef CHECKDEPEND
+$(PACKAGEDIR_FCL-PROCESS)/$(FPCMADE):
+	$(MAKE) -C $(PACKAGEDIR_FCL-PROCESS) $(FPCMADE)
+override ALLDEPENDENCIES+=$(PACKAGEDIR_FCL-PROCESS)/$(FPCMADE)
+endif
+else
+PACKAGEDIR_FCL-PROCESS=
+UNITDIR_FCL-PROCESS:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /fcl-process/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_FCL-PROCESS),)
+UNITDIR_FCL-PROCESS:=$(firstword $(UNITDIR_FCL-PROCESS))
+else
+UNITDIR_FCL-PROCESS=
+endif
+endif
+ifdef UNITDIR_FCL-PROCESS
+override COMPILER_UNITDIR+=$(UNITDIR_FCL-PROCESS)
+endif
+endif
 ifdef REQUIRE_PACKAGES_UNIVINT
 PACKAGEDIR_UNIVINT:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /univint/Makefile.fpc,$(PACKAGESDIR))))))
 ifneq ($(PACKAGEDIR_UNIVINT),)
@@ -2286,9 +2343,6 @@ endif
 ifdef EXEFILES
 override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES))
 endif
-ifdef CLEAN_PROGRAMS
-override CLEANEXEFILES+=$(addprefix $(TARGETDIRPREFIX),$(addsuffix $(EXEEXT), $(CLEAN_PROGRAMS)))
-endif
 ifdef CLEAN_UNITS
 override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS))
 endif
@@ -2335,9 +2389,6 @@ endif
 ifdef CLEANRSTFILES
 	-$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
 endif
-endif
-ifdef CLEAN_FILES
-	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)

packages/fcl-web/src/jsonrpc/Makefile.fpc

@@ -10,7 +10,7 @@ version=2.5.1
 units=fpjsonrpc  webjsonrpc fpextdirect
 
 [require]
-packages=fcl-base fcl-xml fcl-json
+packages=fcl-base fcl-xml fcl-json fcl-process
 
 [compiler]
 options=-S2h

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

@@ -34,6 +34,8 @@ Type
     Class Function ParamsProperty : String; override;
     // Add session support
     Function FindHandler(Const AClassName,AMethodName : TJSONStringType;AContext : TJSONRPCCallContext; Out FreeObject : TComponent) : TCustomJSONRPCHandler; override;
+    // Add type field
+    function CreateJSON2Error(Const AMessage : String; Const ACode : Integer; ID : TJSONData = Nil; idname : TJSONStringType = 'id' ) : TJSONObject; override;
     // Create API
     Function DoAPI : TJSONData; virtual;
     // Namespace for API description. Must be set. Default 'FPWeb'
@@ -92,6 +94,7 @@ Type
   private
     FAPIPath: String;
     FDispatcher: TCustomExtDirectDispatcher;
+    FNameSpace: String;
     FOptions: TJSONRPCDispatchOptions;
     FRequest: TRequest;
     FResponse: TResponse;
@@ -110,6 +113,8 @@ Type
     Property APIPath : String Read FAPIPath Write FAPIPath;
     // Router path/action. Append to baseURL to get router. Default 'router'
     Property RouterPath : String Read FRouterPath Write FRouterPath;
+    // Namespace
+    Property NameSpace : String Read FNameSpace Write FNameSpace;
   Public
     Constructor CreateNew(AOwner : TComponent; CreateMode : Integer); override;
     Procedure HandleRequest(ARequest : TRequest; AResponse : TResponse); override;
@@ -125,6 +130,7 @@ Type
     Property DispatchOptions;
     Property APIPath;
     Property RouterPath;
+    Property NameSpace;
   end;
 
 implementation
@@ -193,6 +199,13 @@ begin
   {$ifdef extdebug}SendDebugFmt('Done with searching for %s %s : %d',[AClassName,AMethodName,Ord(Assigned(Result))]);{$endif}
 end;
 
+function TCustomExtDirectDispatcher.CreateJSON2Error(const AMessage: String;
+  const ACode: Integer; ID: TJSONData; idname: TJSONStringType): TJSONObject;
+begin
+  Result:=inherited CreateJSON2Error(AMessage,ACode,ID,idname);
+  TJSONObject(Result).Add('type','rpc');
+end;
+
 function TCustomExtDirectDispatcher.DoAPI: TJSONData;
 
 Var
@@ -205,6 +218,7 @@ Var
   HD : TJSONRPCHandlerDef;
 
 begin
+  {$ifdef extdebug}SendDebugFmt('Creating API entries',[]);{$endif}
   D:=TJSONObject.Create;
   try
     D.Add('url',URL);
@@ -234,17 +248,20 @@ begin
       For I:=M.HandlerCount-1 downto 0 do
         begin
         HD:=M.HandlerDefs[i];
+  {$ifdef extdebug}SendDebugFmt('Creating API entry for %s.%s',[HD.HandlerClassName,HD.HandlerMethodName]);{$endif}
         If (R=Nil) or (CompareText(N,HD.HandlerClassName)<>0) then
           begin
+  {$ifdef extdebug}SendDebugFmt('Seems like new action entry : %s<> %s',[HD.HandlerClassName,N]);{$endif}
           N:=HD.HandlerClassName;
-          J:=A.IndexOf(R);
+          J:=A.IndexOfName(N);
           If (J=-1) then
             begin
+  {$ifdef extdebug}SendDebugFmt('Creating new action entry : %s ',[N]);{$endif}
             R:=TJSONArray.Create;
             A.Add(N,R);
             end
           else
-            R:=A.Items[i] as TJSONArray;
+            R:=A.Items[J] as TJSONArray;
           end;
         R.Add(TJSONObject.Create(['name',HD.HandlerMethodName,'len',HD.ArgumentCount]));
         end;
@@ -360,6 +377,7 @@ begin
   E:=TExtDirectDispatcher.Create(Self);
   E.Options:=DispatchOptions;
   E.URL:=IncludeHTTPPathDelimiter(BaseURL)+RouterPath;
+  E.NameSpace:=NameSpace;
   Result:=E
 end;
 
@@ -398,8 +416,14 @@ Var
   R : String;
 
 begin
+  {$ifdef extdebug}SendDebug('Ext.Direct handlerequest: checking session');{$endif}
+  CheckSession(ARequest);
+  {$ifdef extdebug}SendDebug('Ext.Direct handlerequest: init session ');{$endif}
+  InitSession(AResponse);
+  {$ifdef extdebug}SendDebug('Ext.Direct creating dispatcher');{$endif}
   If (Dispatcher=Nil) then
     Dispatcher:=CreateDispatcher;
+  {$ifdef extdebug}SendDebugFmt('Ext.Direct handlerequest: dispatcher class is "%s"',[Dispatcher.Classname]);{$endif}
   Disp:=Dispatcher as TCustomExtDirectDispatcher;
   R:=ARequest.QueryFields.Values['action'];
   If (R='') then
@@ -408,12 +432,14 @@ begin
   If (CompareText(R,APIPath)=0) then
     begin
     CreateAPI(Disp,ARequest,AResponse);
+    UpdateSession(AResponse);
     AResponse.SendResponse;
     end
   else if (CompareText(R,RouterPath)=0) then
     begin
     Res:=DispatchRequest(ARequest,Disp);
     try
+      UpdateSession(AResponse);
       If Assigned(Res) then
         AResponse.Content:=Res.AsJSON;
       AResponse.SendResponse;

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

@@ -133,6 +133,7 @@ Type
     FOnStartBatch: TNotifyEvent;
     FOptions: TJSONRPCDispatchOptions;
   Protected
+
     // Find handler. If none found, nil is returned. Executes OnFindHandler if needed.
     // On return 'DoFree' must be set to indicate that the hand
     Function FindHandler(Const AClassName,AMethodName : TJSONStringType;AContext : TJSONRPCCallContext; Out FreeObject : TComponent) : TCustomJSONRPCHandler; virtual;
@@ -151,6 +152,9 @@ Type
     Function CheckRequests(Requests : TJSONData) : TJSONData; virtual;
     // Format result of a single request. Result is returned to the client, possibly in an array if multiple requests were received in batch.
     Function FormatResult(const AClassName, AMethodName: TJSONStringType;  const Params, ID, Return: TJSONData) : TJSONData; virtual;
+    // Format error of a single request.
+    function CreateJSON2Error(Const AMessage : String; Const ACode : Integer; ID : TJSONData = Nil; idname : TJSONStringType = 'id' ) : TJSONObject; virtual;
+    function CreateJSON2Error(Const AFormat : String; Args : Array of const; Const ACode : Integer; ID : TJSONData = Nil; idname : TJSONStringType = 'id') : TJSONObject;
     // Hooks for user.
     Property OnStartBatch : TNotifyEvent Read FOnStartBatch Write FOnStartBatch;
     Property OnDispatchRequest : TDispatchRequestEvent Read FOnDispatchRequest Write FOnDispatchRequest;
@@ -352,7 +356,7 @@ implementation
 function CreateJSONErrorObject(Const AMessage : String; Const ACode : Integer) : TJSONObject;
 
 begin
-  Result:=TJSONObject.Create(['code',ACode,'message',AMessage])
+  Result:=TJSONErrorObject.Create(['code',ACode,'message',AMessage])
 end;
 
 function CreateJSON2ErrorResponse(Const AMessage : String; Const ACode : Integer; ID : TJSONData = Nil; idname : TJSONStringType = 'id' ) : TJSONObject;
@@ -414,11 +418,18 @@ end;
 { TJSONParamDef }
 
 procedure TJSONParamDef.SetName(const AValue: TJSONStringType);
+
+Var
+  D: TJSONParamDef;
+
 begin
   if FName=AValue then exit;
   If Assigned(Collection) and (Collection is TJSONParamDefs) then
-    if (Collection as TJSONParamDefs).FindParamDef(AValue)<>Nil then
+    begin
+    D:=(Collection as TJSONParamDefs).FindParamDef(AValue);
+    If (D<>Nil) and (D<>Self) then
       JSONRPCError(SErrDuplicateParam,[AValue]);
+    end;
   FName:=AValue;
 end;
 
@@ -572,6 +583,7 @@ end;
 
 function TJSONRPCHandler.DoExecute(const Params: TJSONData;AContext : TJSONRPCCallContext): TJSONData;
 begin
+  Result:=Nil;
   If Assigned(FOnExecute) then
     FOnExecute(Self,Params,Result);
 end;
@@ -646,9 +658,9 @@ begin
   H:=FindHandler(AClassName,AMethodName,AContext,FreeObject);
   If (H=Nil) then
     if (AClassName='') then
-      Exit(CreateJSON2ErrorResponse(SErrInvalidMethodName,[AMethodName],EJSONRPCMethodNotFound,ID.Clone,transactionProperty))
+      Exit(CreateJSON2Error(SErrInvalidMethodName,[AMethodName],EJSONRPCMethodNotFound,ID.Clone,transactionProperty))
     else
-      Exit(CreateJSON2ErrorResponse(SErrInvalidClassMethodName,[AClassName,AMethodName],EJSONRPCMethodNotFound,ID.Clone,transactionProperty));
+      Exit(CreateJSON2Error(SErrInvalidClassMethodName,[AClassName,AMethodName],EJSONRPCMethodNotFound,ID.Clone,transactionProperty));
   try
     If Assigned(FOndispatchRequest) then
       FOndispatchRequest(Self,AClassName,AMethodName,Params);
@@ -668,6 +680,19 @@ begin
     TJSONObject(Result).Add('jsonrpc','2.0');
 end;
 
+function TCustomJSONRPCDispatcher.CreateJSON2Error(const AMessage: String;
+  const ACode: Integer; ID: TJSONData; idname: TJSONStringType): TJSONObject;
+begin
+  Result:=CreateJSON2ErrorResponse(AMessage,ACode,ID,IDName);
+end;
+
+function TCustomJSONRPCDispatcher.CreateJSON2Error(const AFormat: String;
+  Args: array of const; const ACode: Integer; ID: TJSONData;
+  idname: TJSONStringType): TJSONObject;
+begin
+  Result:=CreateJSON2Error(Format(AFormat,Args),ACode,ID,IDName);
+end;
+
 function TCustomJSONRPCDispatcher.ExecuteRequest(ARequest: TJSONData;AContext : TJSONRPCCallContext): TJSONData;
 
 Var
@@ -687,21 +712,19 @@ begin
         begin
         // No response, and a response was expected.
         if (ID<>Nil) or not (jdoNotifications in Options) then
-          Result:=CreateJSON2ErrorResponse(SErrNoResponse,[M],EJSONRPCInternalError,ID,transactionProperty);
+          Result:=CreateJSON2Error(SErrNoResponse,[M],EJSONRPCInternalError,ID,transactionProperty);
         end
       else
         begin
         // A response was received, and no response was expected.
         if ((ID=Nil) or (ID is TJSONNull))  and (jdoStrictNotifications in Options) then
-          Result:=CreateJSON2ErrorResponse(SErrResponseFromNotification,[M],EJSONRPCInternalError,ID,transactionProperty);
+          Result:=CreateJSON2Error(SErrResponseFromNotification,[M],EJSONRPCInternalError,ID,transactionProperty);
         If (ID=Nil) or (ID is TJSONNull) then // Notification method, discard result.
           FreeAndNil(Result);
         end;
       end;
     If Assigned(Result) and not (Result is TJSONErrorObject) then
-      begin
-      Result:=FormatResult(C,M,P,ID,Result);
-      end;
+        Result:=FormatResult(C,M,P,ID,Result)
   except
     // Something went really wrong if we end up here.
     On E : Exception do
@@ -709,9 +732,9 @@ begin
       If (Result<>Nil) then
         FreeAndNil(Result);
       If Assigned(ID) then
-        Result:=CreateJSON2ErrorResponse(E.Message,EJSONRPCInternalError,ID.Clone,transactionproperty)
+        Result:=CreateJSON2Error(E.Message,EJSONRPCInternalError,ID.Clone,transactionproperty)
       else
-        Result:=CreateJSON2ErrorResponse(E.Message,EJSONRPCInternalError,Nil,transactionproperty)
+        Result:=CreateJSON2Error(E.Message,EJSONRPCInternalError,Nil,transactionproperty);
       end;
   end;
 end;
@@ -757,7 +780,7 @@ begin
   Params:=Nil;
   Result:=Nil;
   If Not (Request is TJSONObject) then
-    Exit(CreateJSON2ErrorResponse(SErrRequestMustBeObject,EJSONRPCInvalidRequest,Nil,transactionproperty));
+    Exit(CreateJSON2Error(SErrRequestMustBeObject,EJSONRPCInvalidRequest,Nil,transactionproperty));
   O:=TJSONObject(Request);
   // Get ID object, if it exists.
   I:=O.IndexOfName(TransactionProperty);
@@ -765,31 +788,31 @@ begin
     ID:=O.Items[i];
   // Check ID
   If (ID=Nil) and not (jdoNotifications in Options) then
-    Exit(CreateJSON2ErrorResponse(SErrNoIDProperty,EJSONRPCInvalidRequest,Nil,transactionproperty));
+    Exit(CreateJSON2Error(SErrNoIDProperty,EJSONRPCInvalidRequest,Nil,transactionproperty));
   OJ2:=(jdoJSONRPC2 in Options) and not (jdoJSONRPC1 in Options);
   If OJ2 then
     begin
     if Assigned(ID) and not (ID.JSONType in [jtNull,jtString,jtNumber]) then
-      Exit(CreateJSON2ErrorResponse(SErrINvalidIDProperty,EJSONRPCInvalidRequest,Nil,transactionproperty));
+      Exit(CreateJSON2Error(SErrINvalidIDProperty,EJSONRPCInvalidRequest,Nil,transactionproperty));
     // Check presence and value of jsonrpc property
     I:=O.IndexOfName('jsonrpc');
     If (I=-1) then
-      Exit(CreateJSON2ErrorResponse(SErrNoJSONRPCProperty,EJSONRPCInvalidRequest,ID,transactionproperty));
+      Exit(CreateJSON2Error(SErrNoJSONRPCProperty,EJSONRPCInvalidRequest,ID,transactionproperty));
     If (O.Items[i].JSONType<>jtString) or (O.Items[i].AsString<>'2.0') then
-      Exit(CreateJSON2ErrorResponse(SErrInvalidJSONRPCProperty,EJSONRPCInvalidRequest,ID,transactionproperty));
+      Exit(CreateJSON2Error(SErrInvalidJSONRPCProperty,EJSONRPCInvalidRequest,ID,transactionproperty));
     end;
   // Get method name, if it exists.
   I:=O.IndexOfName(MethodProperty);
   If (I<>-1) then
     D:=O.Items[i]
   else
-    Exit(CreateJSON2ErrorResponse(SErrNoMethodName,[MethodProperty],EJSONRPCInvalidRequest,ID,transactionproperty));
+    Exit(CreateJSON2Error(SErrNoMethodName,[MethodProperty],EJSONRPCInvalidRequest,ID,transactionproperty));
   // Check if it is a string
   if Not (D is TJSONString) then
-    Exit(CreateJSON2ErrorResponse(SErrInvalidMethodType,[MethodProperty],EJSONRPCInvalidRequest,ID,transactionproperty));
+    Exit(CreateJSON2Error(SErrInvalidMethodType,[MethodProperty],EJSONRPCInvalidRequest,ID,transactionproperty));
   AMethodName:=D.AsString;
   If (AMethodName='') then
-    Exit(CreateJSON2ErrorResponse(SErrNoMethodName,[MethodProperty],EJSONRPCInvalidRequest,ID,transactionproperty));
+    Exit(CreateJSON2Error(SErrNoMethodName,[MethodProperty],EJSONRPCInvalidRequest,ID,transactionproperty));
   // Get class name, if it exists and is required
   If (ClassNameProperty<>'') then
     begin
@@ -797,31 +820,31 @@ begin
     If (I<>-1) then
       D:=O.Items[i]
     else if (jdoRequireClass in options) then
-      Exit(CreateJSON2ErrorResponse(SErrNoClassName,[ClassNameProperty],EJSONRPCInvalidRequest,ID,transactionproperty));
+      Exit(CreateJSON2Error(SErrNoClassName,[ClassNameProperty],EJSONRPCInvalidRequest,ID,transactionproperty));
     // Check if it is a string
     if Not (D is TJSONString) then
-      Exit(CreateJSON2ErrorResponse(SErrInvalidClassNameType,[ClassNameProperty],EJSONRPCInvalidRequest,ID,transactionproperty));
+      Exit(CreateJSON2Error(SErrInvalidClassNameType,[ClassNameProperty],EJSONRPCInvalidRequest,ID,transactionproperty));
     AClassName:=D.AsString;
     If (AMethodName='') and (jdoRequireClass in options)  then
-      Exit(CreateJSON2ErrorResponse(SErrNoClassName,[ClassNameProperty],EJSONRPCInvalidRequest,ID,transactionproperty));
+      Exit(CreateJSON2Error(SErrNoClassName,[ClassNameProperty],EJSONRPCInvalidRequest,ID,transactionproperty));
     end;
   // Get params, if they exist
   I:=O.IndexOfName(ParamsProperty);
   If (I<>-1) then
     D:=O.Items[i]
   else
-    Exit(CreateJSON2ErrorResponse(SErrNoParams,[ParamsProperty],EJSONRPCInvalidParams,ID,transactionproperty));
+    Exit(CreateJSON2Error(SErrNoParams,[ParamsProperty],EJSONRPCInvalidParams,ID,transactionproperty));
   if OJ2 then
     begin
     // Allow array or object
     If Not (D.JSONType in [jtArray,jtObject]) then
-      Exit(CreateJSON2ErrorResponse(SErrParamsMustBeArrayorObject,EJSONRPCInvalidParams,ID,transactionproperty));
+      Exit(CreateJSON2Error(SErrParamsMustBeArrayorObject,EJSONRPCInvalidParams,ID,transactionproperty));
     end
   else if not (jdoJSONRPC2 in Options) then
     begin
     // Allow only array
     If Not (D.JSONType in [jtArray]) then
-      Exit(CreateJSON2ErrorResponse(SErrParamsMustBeArray,EJSONRPCInvalidParams,ID,transactionproperty));
+      Exit(CreateJSON2Error(SErrParamsMustBeArray,EJSONRPCInvalidParams,ID,transactionproperty));
     end;
   Params:=D;
 end;

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

@@ -80,6 +80,9 @@ end;
 function TExtJSJSONDataFormatter.AddFieldToJSON(O : TJSONObject; AFieldName : String; F : TField): TJSONData;
 
 begin
+ if F.IsNull then
+   Result:=O.Items[O.Add(AFieldName)]
+ else
   Case F.DataType of
     ftSmallint,
     ftInteger,

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

@@ -19,13 +19,16 @@ Type
     FIDFieldName: String;
     FOnGetNewID: TNewIDEvent;
     FOnGetParamValue: TGetParamValueEvent;
+    FParams: TParams;
     FSQLS : Array[0..3] of TStringList;
     FConnection: TSQLConnection;
     FQuery : TSQLQuery;
     FLastNewID : String;
     FOnGetParamType : TGetParamTypeEvent;
     function GetS(AIndex: integer): TStrings;
+    procedure RegenerateParams;
     procedure SetConnection(const AValue: TSQLConnection);
+    procedure SetParams(const AValue: TParams);
     procedure SetS(AIndex: integer; const AValue: TStrings);
   Protected
     function CheckDataset : Boolean; virtual;
@@ -52,6 +55,7 @@ Type
     Property OnGetNewID : TNewIDEvent Read FOnGetNewID Write FOnGetNewID;
     property OnGetParameterType : TGetParamTypeEvent Read FOnGetParamType Write FOnGetParamType;
     property OnGetParameterValue : TGetParamValueEvent Read FOnGetParamValue Write FOnGetParamValue;
+    Property Params : TParams Read FParams Write SetParams;
   Public
     Constructor Create(AOwner : TComponent); override;
     Destructor Destroy; override;
@@ -69,6 +73,7 @@ Type
     property OnGetParameterType;
     property OnGetParameterValue;
     Property Options;
+    Property Params;
   end;
 
 implementation
@@ -107,6 +112,12 @@ begin
     FConnection.FreeNotification(Self);
 end;
 
+procedure TCustomSQLDBWebDataProvider.SetParams(const AValue: TParams);
+begin
+  if FParams=AValue then exit;
+  FParams.Assign(AValue);
+end;
+
 procedure TCustomSQLDBWebDataProvider.SetS(AIndex: integer;
   const AValue: TStrings);
 begin
@@ -119,9 +130,22 @@ begin
     begin
     FQuery.Close;
     FQuery.SQL.Assign(SelectSQL);
+    If Not (csLoading in ComponentState) then
+      RegenerateParams;
     end;
 end;
 
+procedure TCustomSQLDBWebDataProvider.RegenerateParams;
+
+Var
+  S : String;
+
+begin
+  S:=SelectSQL.Text;
+  Params.Clear;
+  Params.ParseSQL(S,True);
+end;
+
 procedure TCustomSQLDBWebDataProvider.ExecuteSQL(ASQL : TStrings; Msg : String = ''; DoNewID : Boolean = False);
 
 Var
@@ -407,6 +431,7 @@ begin
     L.OnChange:=@SQLChanged;
     FSQLS[i]:=L;
     end;
+  FParams:=TParams.Create(TParam);
 end;
 
 destructor TCustomSQLDBWebDataProvider.Destroy;
@@ -419,6 +444,7 @@ begin
    FreeAndNil(FSQLS[i]);
   Connection:=Nil;
   FreeAndNil(FQuery);
+  FreeAndNil(FParams);
   inherited Destroy;
 end;
 

packages/fpvectorial/Makefile.fpc

@@ -15,7 +15,7 @@ units=fpvectbuildunit
 exampledirs=
 implicitunits= avisocncgcodereader avisocncgcodewriter avisozlib fpvectorial \
 	       fpvtocanvas  pdfvectorialreader pdfvrlexico pdfvrsemantico \
-	       pdfvrsintatico
+	       pdfvrsintatico cdrvectorialreader svgvectorialwriter
 
 [compiler]
 includedir=src

packages/fpvectorial/examples/cdr2svg_mainform.lfm

@@ -0,0 +1,80 @@
+object Form1: TForm1
+  Left = 216
+  Height = 240
+  Top = 192
+  Width = 240
+  Caption = 'cdr2svg'
+  ClientHeight = 240
+  ClientWidth = 240
+  LCLVersion = '0.9.29'
+  object Label1: TLabel
+    Left = 8
+    Height = 14
+    Top = 80
+    Width = 215
+    Caption = 'Location of the Input Corel Draw (*.cdr) file:'
+    ParentColor = False
+  end
+  object Label2: TLabel
+    Left = 8
+    Height = 59
+    Top = 8
+    Width = 224
+    AutoSize = False
+    Caption = 'This example project uses fpvectorial to convert a Corel Draw file (*.cdr) to an SVG (*.svg) vectorial graphics file.'
+    ParentColor = False
+    WordWrap = True
+  end
+  object editInput: TFileNameEdit
+    Left = 8
+    Height = 21
+    Top = 104
+    Width = 192
+    DialogOptions = []
+    FilterIndex = 0
+    HideDirectories = False
+    ButtonWidth = 23
+    NumGlyphs = 0
+    MaxLength = 0
+    TabOrder = 0
+  end
+  object Label3: TLabel
+    Left = 8
+    Height = 14
+    Top = 138
+    Width = 154
+    Caption = 'Full path of the Output SVG file:'
+    ParentColor = False
+  end
+  object editOutput: TFileNameEdit
+    Left = 8
+    Height = 21
+    Top = 160
+    Width = 192
+    DialogOptions = []
+    FilterIndex = 0
+    HideDirectories = False
+    ButtonWidth = 23
+    NumGlyphs = 0
+    MaxLength = 0
+    TabOrder = 1
+  end
+  object buttonConvert: TButton
+    Left = 32
+    Height = 25
+    Top = 200
+    Width = 75
+    Caption = 'Convert'
+    OnClick = buttonConvertClick
+    TabOrder = 2
+  end
+  object buttonQuit: TButton
+    Left = 136
+    Height = 25
+    Top = 200
+    Width = 75
+    Caption = 'Quit'
+    OnClick = buttonQuitClick
+    TabOrder = 3
+  end
+end

packages/fpvectorial/examples/cdr2svg_mainform.pas

@@ -0,0 +1,66 @@
+unit cdr2svg_mainform;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
+  EditBtn;
+
+type
+
+  { TForm1 }
+
+  TForm1 = class(TForm)
+    buttonConvert: TButton;
+    buttonQuit: TButton;
+    editInput: TFileNameEdit;
+    editOutput: TFileNameEdit;
+    Label1: TLabel;
+    Label2: TLabel;
+    Label3: TLabel;
+    procedure buttonConvertClick(Sender: TObject);
+    procedure buttonQuitClick(Sender: TObject);
+  private
+    { private declarations }
+  public
+    { public declarations }
+  end; 
+
+var
+  Form1: TForm1; 
+
+implementation
+
+uses
+  fpvectorial, cdrvectorialreader, svgvectorialwriter;
+
+{$R *.lfm}
+
+{ TForm1 }
+
+procedure TForm1.buttonQuitClick(Sender: TObject);
+begin
+  Close;
+end;
+
+procedure TForm1.buttonConvertClick(Sender: TObject);
+var
+  Vec: TvVectorialDocument;
+begin
+  // First check the in input
+  // todo...
+
+  // Now convert
+  Vec := TvVectorialDocument.Create;
+  try
+    Vec.ReadFromFile(editInput.FileName, vfPDF);
+    Vec.WriteToFile(editOutPut.FileName, vfGCodeAvisoCNCPrototipoV5);
+  finally
+    Vec.Free;
+  end;
+end;
+
+end.
+

packages/fpvectorial/examples/cdr2svg_visual.lpi

@@ -0,0 +1,85 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="9"/>
+    <PathDelim Value="\"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="cdr2svg_visual"/>
+      <UseXPManifest Value="True"/>
+      <Icon Value="0"/>
+    </General>
+    <i18n>
+      <EnableI18N LFM="False"/>
+    </i18n>
+    <VersionInfo>
+      <StringTable ProductVersion=""/>
+    </VersionInfo>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="1">
+      <Item1>
+        <PackageName Value="LCL"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="2">
+      <Unit0>
+        <Filename Value="cdr2svg_visual.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="cdr2svg_visual"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="cdr2svg_mainform.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="Form1"/>
+        <ResourceBaseClass Value="Form"/>
+        <UnitName Value="cdr2svg_mainform"/>
+      </Unit1>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="9"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="cdr2svg_visual"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)\"/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Linking>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+    <Other>
+      <CompilerMessages>
+        <UseMsgFile Value="True"/>
+      </CompilerMessages>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

packages/fpvectorial/examples/cdr2svg_visual.lpr

@@ -0,0 +1,20 @@
+program cdr2svg_visual;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Interfaces, // this includes the LCL widgetset
+  Forms, cdr2svg_mainform
+  { you can add units after this };
+
+{$R *.res}
+
+begin
+  Application.Initialize;
+  Application.CreateForm(TForm1, Form1);
+  Application.Run;
+end.
+

packages/fpvectorial/examples/fpce_mainform.lfm

@@ -0,0 +1,54 @@
+object formCorelExplorer: TformCorelExplorer
+  Left = 216
+  Height = 345
+  Top = 192
+  Width = 466
+  Caption = 'FP Corel Explorer'
+  ClientHeight = 345
+  ClientWidth = 466
+  LCLVersion = '0.9.29'
+  object Label1: TLabel
+    Left = 8
+    Height = 14
+    Top = 40
+    Width = 123
+    Caption = 'Location of the Input file:'
+    ParentColor = False
+  end
+  object Label2: TLabel
+    Left = 8
+    Height = 32
+    Top = 8
+    Width = 224
+    AutoSize = False
+    Caption = 'This application helps us explore the internal structure of Corel Draw files (*.cdr).'
+    ParentColor = False
+    WordWrap = True
+  end
+  object shellInput: TShellTreeView
+    Left = 8
+    Height = 272
+    Top = 64
+    Width = 224
+    FileSortType = fstFoldersFirst
+    TabOrder = 0
+    OnSelectionChanged = shellInputSelectionChanged
+    ObjectTypes = [otFolders, otNonFolders]
+  end
+  object labelFilename: TLabel
+    Left = 256
+    Height = 14
+    Top = 65
+    Width = 47
+    Caption = 'Filename:'
+    ParentColor = False
+  end
+  object labelVersion: TLabel
+    Left = 256
+    Height = 14
+    Top = 88
+    Width = 40
+    Caption = 'Version:'
+    ParentColor = False
+  end
+end

packages/fpvectorial/examples/fpce_mainform.pas

@@ -0,0 +1,85 @@
+unit fpce_mainform;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
+  EditBtn, ExtCtrls, ComCtrls, ShellCtrls;
+
+type
+
+  { TformCorelExplorer }
+
+  TformCorelExplorer = class(TForm)
+    Label1: TLabel;
+    Label2: TLabel;
+    labelVersion: TLabel;
+    labelFilename: TLabel;
+    shellInput: TShellTreeView;
+    procedure buttonQuitClick(Sender: TObject);
+    procedure shellInputSelectionChanged(Sender: TObject);
+  private
+    { private declarations }
+    function CheckInput(): Boolean;
+  public
+    { public declarations }
+  end; 
+
+var
+  formCorelExplorer: TformCorelExplorer;
+
+implementation
+
+uses
+  fpvectorial, cdrvectorialreader, svgvectorialwriter, pdfvectorialreader,
+  fpvtocanvas;
+
+{$R *.lfm}
+
+{ TformCorelExplorer }
+
+procedure TformCorelExplorer.buttonQuitClick(Sender: TObject);
+begin
+  Close;
+end;
+
+procedure TformCorelExplorer.shellInputSelectionChanged(Sender: TObject);
+var
+  Vec: TvVectorialDocument;
+  Reader: TvCDRVectorialReader;
+  lFormat: TvVectorialFormat;
+  lChunk, lCurChunk: TCDRChunk;
+  Str: string;
+begin
+  // First check the in input
+  if not CheckInput() then Exit;
+
+  // Now read the data from the input file
+  Reader := TvCDRVectorialReader.Create;
+  try
+    Reader.ExploreFromFile(shellInput.GetSelectedNodePath(), lChunk);
+
+    labelFilename.Caption := 'Filename: ' + shellInput.GetSelectedNodePath();
+    if (lChunk.ChildChunks <> nil) and (lChunk.ChildChunks.First <> nil) then
+    begin
+      lCurChunk := TCDRChunk(lChunk.ChildChunks.First);
+      Str := TCDRChunkVRSN(lCurChunk).VersionStr;
+      labelVersion.Caption := 'Version: ' + Str;
+    end;
+  finally
+    Reader.Free;
+  end;
+end;
+
+function TformCorelExplorer.CheckInput(): Boolean;
+var
+  lPath: String;
+begin
+  lPath := shellInput.GetSelectedNodePath();
+  Result := (ExtractFileExt(lPath) = STR_CORELDRAW_EXTENSION);
+end;
+
+end.
+

packages/fpvectorial/examples/fpcorelexplorer.lpi

@@ -0,0 +1,91 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="9"/>
+    <PathDelim Value="\"/>
+    <General>
+      <Flags>
+        <AlwaysBuild Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="fpcorelexplorer"/>
+      <UseXPManifest Value="True"/>
+      <Icon Value="0"/>
+    </General>
+    <i18n>
+      <EnableI18N LFM="False"/>
+    </i18n>
+    <VersionInfo>
+      <StringTable ProductVersion=""/>
+    </VersionInfo>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="1">
+      <Item1>
+        <PackageName Value="LCL"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="2">
+      <Unit0>
+        <Filename Value="fpcorelexplorer.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="fpcorelexplorer"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="fpce_mainform.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="formCorelExplorer"/>
+        <ResourceBaseClass Value="Form"/>
+        <UnitName Value="fpce_mainform"/>
+      </Unit1>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="9"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="fpcorelexplorer"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)\"/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Linking>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+    <Other>
+      <CompilerMessages>
+        <UseMsgFile Value="True"/>
+      </CompilerMessages>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="4">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+      <Item4>
+        <Name Value="EConvertError"/>
+      </Item4>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

packages/fpvectorial/examples/fpcorelexplorer.lpr

@@ -0,0 +1,20 @@
+program fpcorelexplorer;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Interfaces, // this includes the LCL widgetset
+  Forms, fpce_mainform
+  { you can add units after this };
+
+{$R *.res}
+
+begin
+  Application.Initialize;
+  Application.CreateForm(TformCorelExplorer, formCorelExplorer);
+  Application.Run;
+end.
+

packages/fpvectorial/examples/fpvc_mainform.lfm

@@ -0,0 +1,96 @@
+object formVectorialConverter: TformVectorialConverter
+  Left = 216
+  Height = 439
+  Top = 192
+  Width = 240
+  BorderStyle = bsSingle
+  Caption = 'FP Vectorial Converter'
+  ClientHeight = 439
+  ClientWidth = 240
+  LCLVersion = '0.9.29'
+  object Label1: TLabel
+    Left = 8
+    Height = 14
+    Top = 104
+    Width = 123
+    Caption = 'Location of the Input file:'
+    ParentColor = False
+  end
+  object Label2: TLabel
+    Left = 11
+    Height = 96
+    Top = 8
+    Width = 224
+    AutoSize = False
+    Caption = 'This converter application use the fpvectorial library to convert between various different vectorial graphics formats. The type is detected from the extension and the supported types are: PDF (*.pdf), SVG (*.svg) and Corel Draw file (*.cdr).'
+    ParentColor = False
+    WordWrap = True
+  end
+  object editInput: TFileNameEdit
+    Left = 8
+    Height = 21
+    Top = 120
+    Width = 192
+    DialogOptions = []
+    FilterIndex = 0
+    HideDirectories = False
+    ButtonWidth = 23
+    NumGlyphs = 0
+    MaxLength = 0
+    TabOrder = 0
+  end
+  object Label3: TLabel
+    Left = 8
+    Height = 14
+    Top = 144
+    Width = 132
+    Caption = 'Full path of the Output file:'
+    ParentColor = False
+  end
+  object editOutput: TFileNameEdit
+    Left = 8
+    Height = 21
+    Top = 160
+    Width = 192
+    DialogOptions = []
+    FilterIndex = 0
+    HideDirectories = False
+    ButtonWidth = 23
+    NumGlyphs = 0
+    MaxLength = 0
+    TabOrder = 1
+  end
+  object buttonConvert: TButton
+    Left = 87
+    Height = 25
+    Top = 192
+    Width = 67
+    Caption = 'Convert'
+    OnClick = buttonConvertClick
+    TabOrder = 2
+  end
+  object buttonQuit: TButton
+    Left = 176
+    Height = 25
+    Top = 192
+    Width = 59
+    Caption = 'Quit'
+    OnClick = buttonQuitClick
+    TabOrder = 3
+  end
+  object imagePreview: TImage
+    Left = 8
+    Height = 210
+    Top = 224
+    Width = 224
+  end
+  object buttonVisualize: TButton
+    Left = 8
+    Height = 25
+    Top = 192
+    Width = 59
+    Caption = 'Visualize'
+    OnClick = buttonVisualizeClick
+    TabOrder = 4
+  end
+end

packages/fpvectorial/examples/fpvc_mainform.pas

@@ -0,0 +1,97 @@
+unit fpvc_mainform;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
+  EditBtn, ExtCtrls;
+
+type
+
+  { TformVectorialConverter }
+
+  TformVectorialConverter = class(TForm)
+    buttonVisualize: TButton;
+    buttonConvert: TButton;
+    buttonQuit: TButton;
+    editInput: TFileNameEdit;
+    editOutput: TFileNameEdit;
+    imagePreview: TImage;
+    Label1: TLabel;
+    Label2: TLabel;
+    Label3: TLabel;
+    procedure buttonConvertClick(Sender: TObject);
+    procedure buttonQuitClick(Sender: TObject);
+    procedure buttonVisualizeClick(Sender: TObject);
+  private
+    { private declarations }
+    function CheckInput(): Boolean;
+  public
+    { public declarations }
+  end; 
+
+var
+  formVectorialConverter: TformVectorialConverter;
+
+implementation
+
+uses
+  fpvectorial, cdrvectorialreader, svgvectorialwriter, pdfvectorialreader,
+  fpvtocanvas;
+
+{$R *.lfm}
+
+{ TformVectorialConverter }
+
+procedure TformVectorialConverter.buttonQuitClick(Sender: TObject);
+begin
+  Close;
+end;
+
+procedure TformVectorialConverter.buttonVisualizeClick(Sender: TObject);
+var
+  Vec: TvVectorialDocument;
+begin
+  // First check the in input
+  if not CheckInput() then Exit;
+
+  Vec := TvVectorialDocument.Create;
+  try
+    Vec.ReadFromFile(editInput.FileName, vfPDF);
+    imagePreview.Canvas.Brush.Color := clWhite;
+    imagePreview.Canvas.FillRect(0, 0, imagePreview.Width, imagePreview.Height);
+    DrawFPVectorialToCanvas(Vec, imagePreview.Canvas);
+  finally
+    Vec.Free;
+  end;
+end;
+
+function TformVectorialConverter.CheckInput(): Boolean;
+begin
+  // todo...
+end;
+
+procedure TformVectorialConverter.buttonConvertClick(Sender: TObject);
+var
+  Vec: TvVectorialDocument;
+  lFormat: TvVectorialFormat;
+begin
+  // First check the in input
+  if not CheckInput() then Exit;
+
+  // Now convert
+  Vec := TvVectorialDocument.Create;
+  try
+    lFormat := TvVectorialDocument.GetFormatFromExtension(editInput.FileName);
+    Vec.ReadFromFile(editInput.FileName, lFormat);
+    lFormat := TvVectorialDocument.GetFormatFromExtension(editOutPut.FileName);
+    Vec.WriteToFile(editOutPut.FileName, lFormat);
+  finally
+    Vec.Free;
+  end;
+end;
+
+end.
+

packages/fpvectorial/examples/fpvectorialconverter.lpi

@@ -0,0 +1,91 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="9"/>
+    <PathDelim Value="\"/>
+    <General>
+      <Flags>
+        <AlwaysBuild Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="fpvectorialconverter"/>
+      <UseXPManifest Value="True"/>
+      <Icon Value="0"/>
+    </General>
+    <i18n>
+      <EnableI18N LFM="False"/>
+    </i18n>
+    <VersionInfo>
+      <StringTable ProductVersion=""/>
+    </VersionInfo>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="1">
+      <Item1>
+        <PackageName Value="LCL"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="2">
+      <Unit0>
+        <Filename Value="fpvectorialconverter.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="fpvectorialconverter"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="fpvc_mainform.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="formVectorialConverter"/>
+        <ResourceBaseClass Value="Form"/>
+        <UnitName Value="fpvc_mainform"/>
+      </Unit1>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="9"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="fpvectorialconverter"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)\"/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Linking>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+    <Other>
+      <CompilerMessages>
+        <UseMsgFile Value="True"/>
+      </CompilerMessages>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="4">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+      <Item4>
+        <Name Value="EConvertError"/>
+      </Item4>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

packages/fpvectorial/examples/fpvectorialconverter.lpr

@@ -0,0 +1,20 @@
+program fpvectorialconverter;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Interfaces, // this includes the LCL widgetset
+  Forms, fpvc_mainform
+  { you can add units after this };
+
+{$R *.res}
+
+begin
+  Application.Initialize;
+  Application.CreateForm(TformVectorialConverter, formVectorialConverter);
+  Application.Run;
+end.
+

packages/fpvectorial/src/cdrvectorialreader.pas

@@ -0,0 +1,180 @@
+{
+cdrvectorialreader.pas
+
+Reads a Corel Draw vectorial file
+
+CDR file format specification obtained from:
+
+ADOBE SYSTEMS INCORPORATED. PDF Reference: Adobe®
+Portable Document Format. San Jose, 2006. (Sixth edition).
+
+AUTHORS: Felipe Monteiro de Carvalho
+
+License: The same modified LGPL as the Free Pascal RTL
+         See the file COPYING.modifiedLGPL for more details
+}
+unit cdrvectorialreader;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+interface
+
+uses
+  Classes, SysUtils,
+  pdfvrlexico, pdfvrsintatico, pdfvrsemantico, avisozlib,
+  fpvectorial;
+
+type
+
+  TCDRChunk = class
+    Name: array[0..3] of Char;
+    Size: Cardinal;
+    ChildChunks: TFPList;
+  end;
+
+  TCDRChunkClass = class of TCDRChunk;
+
+  TvCDRInternalData = TCDRChunk;
+
+  TCDRChunkVRSN = class(TCDRChunk)
+    VersionStr: string;
+    VersionNum: Integer;
+  end;
+
+  { TvCDRVectorialReader }
+
+  TvCDRVectorialReader = class(TvCustomVectorialReader)
+  private
+    procedure ReadVersionChunk(AStream: TStream; var AData: TCDRChunk);
+    function AddNewChunk(var AData: TCDRChunk; AClass: TCDRChunkClass): TCDRChunk;
+  public
+    { General reading methods }
+    procedure ReadFromStream(AStream: TStream; AData: TvVectorialDocument); override;
+    { File format exploring methods }
+    procedure ExploreFromFile(AFilename: string; out AData: TvCDRInternalData);
+    procedure ExploreFromStream(AStream: TStream; out AData: TvCDRInternalData);
+  end;
+
+implementation
+
+{ TvPDFVectorialReader }
+
+procedure TvCDRVectorialReader.ReadVersionChunk(AStream: TStream;
+  var AData: TCDRChunk);
+var
+  lDWord: DWord;
+  lChunk: TCDRChunkVRSN absolute AData;
+  lVerBytes: array[0..1] of Byte;
+begin
+  // Read the Chunk name
+  lDWord := AStream.ReadDWord();
+
+  // Read the Chunk size
+  lDWord := AStream.ReadDWord();
+
+  // Read the version
+  AStream.Read(lVerBytes, 2);
+
+  if (lVerBytes[0] = $BC) and (lVerBytes[1] = $02) then
+  begin
+    lChunk.VersionNum := 7;
+    lChunk.VersionStr := 'CorelDraw 7';
+  end
+  else if (lVerBytes[0] = $20) and (lVerBytes[1] = $03) then
+  begin
+    lChunk.VersionNum := 8;
+    lChunk.VersionStr := 'CorelDraw 8';
+  end
+  else if (lVerBytes[0] = $21) and (lVerBytes[1] = $03) then
+  begin
+    lChunk.VersionNum := 8;
+    lChunk.VersionStr := 'CorelDraw 8bidi';
+  end
+  else if (lVerBytes[0] = $84) and (lVerBytes[1] = $03) then
+  begin
+    lChunk.VersionNum := 9;
+    lChunk.VersionStr := 'CorelDraw 9';
+  end
+  else if (lVerBytes[0] = $E8) and (lVerBytes[1] = $03) then
+  begin
+    lChunk.VersionNum := 10;
+    lChunk.VersionStr := 'CorelDraw 10';
+  end
+  else if (lVerBytes[0] = $4C) and (lVerBytes[1] = $04) then
+  begin
+    lChunk.VersionNum := 11;
+    lChunk.VersionStr := 'CorelDraw 11';
+  end
+  else if (lVerBytes[0] = $B0) and (lVerBytes[1] = $04) then
+  begin
+    lChunk.VersionNum := 12;
+    lChunk.VersionStr := 'CorelDraw 12';
+  end
+  else if (lVerBytes[0] = $14) and (lVerBytes[1] = $05) then
+  begin
+    lChunk.VersionNum := 13;
+    lChunk.VersionStr := 'CorelDraw X3';
+  end;
+end;
+
+function TvCDRVectorialReader.AddNewChunk(var AData: TCDRChunk; AClass: TCDRChunkClass): TCDRChunk;
+begin
+  if AData.ChildChunks = nil then AData.ChildChunks := TFPList.Create;
+
+  Result := AClass.Create;
+
+  AData.ChildChunks.Add(Result);
+end;
+
+procedure TvCDRVectorialReader.ReadFromStream(AStream: TStream;
+  AData: TvVectorialDocument);
+begin
+end;
+
+procedure TvCDRVectorialReader.ExploreFromFile(AFilename: string;
+  out AData: TvCDRInternalData);
+var
+  FileStream: TFileStream;
+begin
+  FileStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyNone);
+  try
+    ExploreFromStream(FileStream, AData);
+  finally
+    FileStream.Free;
+  end;
+end;
+
+procedure TvCDRVectorialReader.ExploreFromStream(AStream: TStream;
+  out AData: TvCDRInternalData);
+var
+  lRIFF: array[0..3] of Char;
+  lDocSize, lDWord: Cardinal;
+  lChild: TCDRChunk;
+begin
+  // Create the data object
+  AData := TCDRChunk.Create;
+
+  // All CorelDraw files starts with "RIFF"
+  AStream.Read(lRIFF, 4);
+  if lRIFF <> 'RIFF' then
+    raise Exception.Create('[TvCDRVectorialReader.ExploreFromStream] The Corel Draw RIFF file marker wasn''t found.');
+
+  // And then 4 bytes for the document size
+  lDocSize := AStream.ReadDWord();
+
+  // And mroe 4 bytes of other stuff
+  lDWord := AStream.ReadDWord();
+
+  // Now comes the version
+  lChild := AddNewChunk(AData, TCDRChunkVRSN);
+  ReadVersionChunk(AStream, lChild);
+end;
+
+initialization
+
+  RegisterVectorialReader(TvCDRVectorialReader, vfCorelDrawCDR);
+
+end.
+

packages/fpvectorial/src/fpvectorial.pas

@@ -31,13 +31,23 @@ type
 
 const
   { Default extensions }
+  { Multi-purpose document formats }
   STR_PDF_EXTENSION = '.pdf';
+  STR_POSTSCRIPT_EXTENSION = '.ps';
+  STR_SVG_EXTENSION = '.svg';
+  STR_CORELDRAW_EXTENSION = '.cdr';
+  STR_WINMETAFILE_EXTENSION = '.wmf';
 
 type
   TSegmentType = (
     st2DLine, st2DBezier,
     st3DLine, st3DBezier);
 
+  {@@
+    The coordinates in fpvectorial are given in millimiters and
+    the starting point is in the bottom-left corner of the document.
+    The X grows to the right and the Y grows to the top.
+  }
   TPathSegment = record
     SegmentType: TSegmentType;
     X, Y, Z: Double; // Z is ignored in 2D segments
@@ -79,6 +89,8 @@ type
     procedure ReadFromFile(AFileName: string; AFormat: TvVectorialFormat);
     procedure ReadFromStream(AStream: TStream; AFormat: TvVectorialFormat);
     procedure ReadFromStrings(AStrings: TStrings; AFormat: TvVectorialFormat);
+    class function GetFormatFromExtension(AFileName: string): TvVectorialFormat;
+    function  GetDetailedFileFormat(): string;
     { Data reading methods }
     function  GetPath(ANum: Cardinal): TPath;
     function  GetPathCount: Integer;
@@ -522,6 +534,26 @@ begin
   end;
 end;
 
+class function TvVectorialDocument.GetFormatFromExtension(AFileName: string
+  ): TvVectorialFormat;
+var
+  lExt: string;
+begin
+  lExt := ExtractFileExt(AFileName);
+  if AnsiCompareText(lExt, STR_PDF_EXTENSION) = 0 then Result := vfPDF
+  else if AnsiCompareText(lExt, STR_POSTSCRIPT_EXTENSION) = 0 then Result := vfPostScript
+  else if AnsiCompareText(lExt, STR_SVG_EXTENSION) = 0 then Result := vfSVG
+  else if AnsiCompareText(lExt, STR_CORELDRAW_EXTENSION) = 0 then Result := vfCorelDrawCDR
+  else if AnsiCompareText(lExt, STR_WINMETAFILE_EXTENSION) = 0 then Result := vfWindowsMetafileWMF
+  else
+    raise Exception.Create('TvVectorialDocument.GetFormatFromExtension: The extension (' + lExt + ') doesn''t match any supported formats.');
+end;
+
+function  TvVectorialDocument.GetDetailedFileFormat(): string;
+begin
+
+end;
+
 function TvVectorialDocument.GetPath(ANum: Cardinal): TPath;
 begin
   if ANum >= FPaths.Count then raise Exception.Create('TvVectorialDocument.GetPath: Path number out of bounds');
@@ -617,10 +649,21 @@ begin
   end;
 end;
 
+{@@
+  The default stream writer just uses WriteToStrings
+}
 procedure TvCustomVectorialWriter.WriteToStream(AStream: TStream;
   AData: TvVectorialDocument);
+var
+  lStringList: TStringList;
 begin
-
+  lStringList := TStringList.Create;
+  try
+    WriteToStrings(lStringList, AData);
+    lStringList.SaveToStream(AStream);
+  finally
+    lStringList.Free;
+  end;
 end;
 
 procedure TvCustomVectorialWriter.WriteToStrings(AStrings: TStrings;

packages/fpvectorial/src/fpvtocanvas.pas

@@ -10,12 +10,26 @@ uses
   fpvectorial;
 
 procedure DrawFPVectorialToCanvas(ASource: TvVectorialDocument; ADest: TFPCustomCanvas;
-  ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Integer = 1; AMulY: Integer = 1);
+  ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
 
 implementation
 
+{@@
+  This function draws a FPVectorial vectorial image to a TFPCustomCanvas
+  descendent, such as TCanvas from the LCL.
+
+  Be careful that by default this routine does not execute coordinate transformations,
+  and that FPVectorial works with a start point in the bottom-left corner, with
+  the X growing to the right and the Y growing to the top. This will result in
+  an image in TFPCustomCanvas mirrored in the Y axis in relation with the document
+  as seen in a PDF viewer, for example. This can be easily changed with the
+  provided parameters. To have the standard view of an image viewer one could
+  use this function like this:
+
+  DrawFPVectorialToCanvas(ASource, ADest, 0, ASource.Height, 1.0, -1.0);
+}
 procedure DrawFPVectorialToCanvas(ASource: TvVectorialDocument; ADest: TFPCustomCanvas;
-  ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Integer = 1; AMulY: Integer = 1);
+  ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
 var
   i, j, k: Integer;
   PosX, PosY: Integer; // Not modified by ADestX, etc
@@ -47,8 +61,8 @@ begin
         PosX := Round(CurSegment.X);
         PosY := Round(CurSegment.Y);
         ADest.LineTo(
-          ADestX + AMulX * PosX,
-          ADestY + AMulY * PosY
+          Round(ADestX + AMulX * PosX),
+          Round(ADestY + AMulY * PosY)
           );
       end;
       { To draw a bezier we need to divide the interval in parts and make
@@ -66,8 +80,8 @@ begin
           CurX := Round(sqr(1 - t) * (1 - t) * PosX + 3 * t * sqr(1 - t) * CurSegment.X2 + 3 * t * t * (1 - t) * CurSegment.X3 + t * t * t * CurSegment.X);
           CurY := Round(sqr(1 - t) * (1 - t) * PosY + 3 * t * sqr(1 - t) * CurSegment.Y2 + 3 * t * t * (1 - t) * CurSegment.Y3 + t * t * t * CurSegment.Y);
           ADest.LineTo(
-            ADestX + AMulX * CurX,
-            ADestY + AMulY * CurY);
+            Round(ADestX + AMulX * CurX),
+            Round(ADestY + AMulY * CurY));
         end;
         PosX := Round(CurSegment.X);
         PosY := Round(CurSegment.Y);

packages/fpvectorial/src/pdfvrsemantico.pas

@@ -8,11 +8,16 @@ uses
   Classes, SysUtils, pdfvrlexico, fpvectorial;
 
 type
+
+  { AnSemantico }
+
   AnSemantico = class
   public
+    FPointSeparator, FCommaSeparator: TFormatSettings;
     close_path_x: String;
     close_path_y: String;
     cm_a, cm_b, cm_c, cm_d, cm_e, cm_f: Real; // coordinate spaces constants
+    function StringToFloat(AStr: string): Double;
     function generate(c: Command; AData: TvVectorialDocument): String;
     function convert(x: String; y: String; Axis: Char): String;
     function startMachine(): String;
@@ -22,6 +27,14 @@ type
 
 implementation
 
+{ PDF doesn't seam very consistent when it comes to using commas or
+  points as decimal separator, so we just try both }
+function AnSemantico.StringToFloat(AStr: string): Double;
+begin
+  if Pos('.', AStr) > 0 then Result := StrToFloat(AStr, FPointSeparator)
+  else Result := StrToFloat(AStr, FCommaSeparator);
+end;
+
 function AnSemantico.generate(c: Command; AData: TvVectorialDocument): String;
 var
   enter_line : String;
@@ -29,6 +42,7 @@ begin
   {$ifdef FPVECTORIALDEBUG}
   WriteLn(':> AnSemantico.generate');
   {$endif}
+
   enter_line:= LineEnding; //chr(13) + chr(10); // CR and LF
 
   if ((c.code = cc_H_CLOSE_PATH) or (c.code = cc_hS_CLOSE_AND_END_PATH)) then // command h or s
@@ -69,7 +83,7 @@ begin
     // Correcao para programas de desenho que geram um novo inicio no
     // fim do desenho, terminamos qualquer desenho inacabado
     AData.EndPath();
-    AData.StartPath(StrToFloat(c.cord_x), StrToFloat(c.cord_y));
+    AData.StartPath(StringToFloat(c.cord_x), StringToFloat(c.cord_y));
 
     close_path_x:=c.cord_x;
     close_path_y:=c.cord_y;
@@ -81,7 +95,7 @@ begin
     {$endif}
     // Result:='G01' + ' ' + 'X' + c.cord_x + ' ' +  'Y' + c.cord_y;
 
-    AData.AddLineToPath(StrToFloat(c.cord_x), StrToFloat(c.cord_y));
+    AData.AddLineToPath(StringToFloat(c.cord_x), StringToFloat(c.cord_y));
   end;
   cc_h_CLOSE_PATH: // command h
   begin
@@ -90,7 +104,7 @@ begin
     {$endif}
     //Result:='G01' + ' ' + 'X' + c.cord_x + ' ' +  'Y' + c.cord_y;
 
-    AData.AddLineToPath(StrToFloat(c.cord_x), StrToFloat(c.cord_y));
+    AData.AddLineToPath(StringToFloat(c.cord_x), StringToFloat(c.cord_y));
   end;
   cc_S_END_PATH: // command S
   begin
@@ -108,7 +122,7 @@ begin
     //Result:='G01' + ' ' + 'X' + c.cord_x + ' ' +  'Y' + c.cord_y + enter_line
     //       +'G01 Z0 // Sobe a cabeça de gravação' + enter_line;
 
-    AData.AddLineToPath(StrToFloat(c.cord_x), StrToFloat(c.cord_y));
+    AData.AddLineToPath(StringToFloat(c.cord_x), StringToFloat(c.cord_y));
     AData.EndPath();
   end;
   cc_c_BEZIER_TO_X_Y_USING_X2_Y2_AND_X3_Y3: // command c
@@ -120,9 +134,9 @@ begin
     //       +'G01 Z0 // Sobe a cabeça de gravação' + enter_line;
 
     AData.AddBezierToPath(
-      StrToFloat(c.cord_x3), StrToFloat(c.cord_y3),
-      StrToFloat(c.cord_x2), StrToFloat(c.cord_y2),
-      StrToFloat(c.cord_x), StrToFloat(c.cord_y)
+      StringToFloat(c.cord_x3), StringToFloat(c.cord_y3),
+      StringToFloat(c.cord_x2), StringToFloat(c.cord_y2),
+      StringToFloat(c.cord_x), StringToFloat(c.cord_y)
       );
   end;
   cc_CONCATENATE_MATRIX: // command cm
@@ -131,12 +145,12 @@ begin
     WriteLn(':> AnSemantico.cc_CONCATENATE_MATRIX');
     {$endif}
 
-    cm_a := StrToFloat(c.cord_x3);
-    cm_b := StrToFloat(c.cord_y3);
-    cm_c := StrToFloat(c.cord_x2);
-    cm_d := StrToFloat(c.cord_y2);
-    cm_e := StrToFloat(c.cord_x);
-    cm_f := StrToFloat(c.cord_y);
+    cm_a := StringToFloat(c.cord_x3);
+    cm_b := StringToFloat(c.cord_y3);
+    cm_c := StringToFloat(c.cord_x2);
+    cm_d := StringToFloat(c.cord_y2);
+    cm_e := StringToFloat(c.cord_x);
+    cm_f := StringToFloat(c.cord_y);
   end;
   cc_RESTORE_MATRIX: // command Q
   begin
@@ -169,13 +183,13 @@ begin
   if (Axis = 'y') then
   begin
        // y' = b * x + d * y + f
-       Result:=FloatToStr((cm_b*StrToFloat(x)+cm_d*StrToFloat(y)+cm_f)*(25.40/72));
+       Result:=FloatToStr((cm_b*StringToFloat(x)+cm_d*StringToFloat(y)+cm_f)*(25.40/72));
   end
   else
   // Axis = 'x'
   begin
        // x' = a * x + c * y + e
-       Result:=FloatToStr((cm_a*StrToFloat(x)+cm_c*StrToFloat(y)+cm_e)*(25.40/72));
+       Result:=FloatToStr((cm_a*StringToFloat(x)+cm_c*StringToFloat(y)+cm_e)*(25.40/72));
   end;
 end;
 
@@ -209,12 +223,21 @@ end;
 constructor AnSemantico.Create;
 begin
   inherited Create;
+
   cm_a:=1;
   cm_b:=0;
   cm_c:=0;
   cm_d:=1;
   cm_e:=0;
   cm_f:=0;
+
+  // Format seetings to convert a string to a float
+  FPointSeparator := DefaultFormatSettings;
+  FPointSeparator.DecimalSeparator := '.';
+  FPointSeparator.ThousandSeparator := '#';// disable the thousand separator
+  FCommaSeparator := DefaultFormatSettings;
+  FCommaSeparator.DecimalSeparator := ',';
+  FCommaSeparator.ThousandSeparator := '#';// disable the thousand separator
 end;
 
 end.

packages/fpvectorial/src/svgvectorialwriter.pas

@@ -0,0 +1,127 @@
+{
+Writes an SVG Document
+
+License: The same modified LGPL as the Free Pascal RTL
+         See the file COPYING.modifiedLGPL for more details
+
+AUTHORS: Felipe Monteiro de Carvalho
+}
+unit svgvectorialwriter;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils,
+  fpvectorial;
+
+type
+  { TvSVGVectorialWriter }
+
+  TvSVGVectorialWriter = class(TvCustomVectorialWriter)
+  private
+    FPointSeparator, FCommaSeparator: TFormatSettings;
+    procedure WriteDocumentSize(AStrings: TStrings; AData: TvVectorialDocument);
+    procedure WriteDocumentName(AStrings: TStrings; AData: TvVectorialDocument);
+    procedure WritePaths(AStrings: TStrings; AData: TvVectorialDocument);
+  public
+    { General reading methods }
+    procedure WriteToStrings(AStrings: TStrings; AData: TvVectorialDocument); override;
+  end;
+
+implementation
+
+{ TvSVGVectorialWriter }
+
+procedure TvSVGVectorialWriter.WriteDocumentSize(AStrings: TStrings; AData: TvVectorialDocument);
+begin
+  AStrings.Add('  width="' + FloatToStr(AData.Width, FPointSeparator) + 'mm"');
+  AStrings.Add('  height="' + FloatToStr(AData.Height, FPointSeparator) + 'mm"');
+end;
+
+procedure TvSVGVectorialWriter.WriteDocumentName(AStrings: TStrings; AData: TvVectorialDocument);
+begin
+  AStrings.Add('  sodipodi:docname="New document 1">');
+end;
+
+{@@
+  SVG Coordinate system measures things in whatever unit we pass to it, so we
+  choose to pass in millimiters (mm), like FPVectorial uses.
+
+  The initial point is in the bottom-left corner of the document and it grows
+  to the top and to the right, just like in FPVectorial.
+
+  SVG uses commas "," to separate the X,Y coordinates, so it always uses points
+  "." as decimal separators and uses no thousand separators
+}
+procedure TvSVGVectorialWriter.WritePaths(AStrings: TStrings; AData: TvVectorialDocument);
+var
+  i, j: Integer;
+  PathStr: string;
+  lPath: TPath;
+  PtX, PtY: double;
+begin
+  for i := 0 to AData.GetPathCount() - 1 do
+  begin
+    PathStr := 'm ';
+    lPath := AData.GetPath(i);
+    for j := 0 to lPath.Len - 1 do
+    begin
+      if lPath.Points[j].SegmentType <> st2DLine then Break; // unsupported line type
+
+      PtX := lPath.Points[j].X;
+      PtY := lPath.Points[j].Y;
+      PathStr := PathStr + FloatToStr(PtX, FPointSeparator) + 'mm,'
+        + FloatToStr(PtY, FPointSeparator) + 'mm ';
+    end;
+
+    AStrings.Add('  <path');
+    AStrings.Add('    style="fill:none;stroke:#000000;stroke-width:1px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"');
+    AStrings.Add('    d="' + PathStr + '"');
+    AStrings.Add('  id="path' + IntToStr(i) + '" />');
+  end;
+end;
+
+procedure TvSVGVectorialWriter.WriteToStrings(AStrings: TStrings;
+  AData: TvVectorialDocument);
+begin
+  // Format seetings to convert a string to a float
+  FPointSeparator := DefaultFormatSettings;
+  FPointSeparator.DecimalSeparator := '.';
+  FPointSeparator.ThousandSeparator := '#';// disable the thousand separator
+  FCommaSeparator := DefaultFormatSettings;
+  FCommaSeparator.DecimalSeparator := ',';
+  FCommaSeparator.ThousandSeparator := '#';// disable the thousand separator
+
+  // Headers
+  AStrings.Add('<?xml version="1.0" encoding="UTF-8" standalone="no"?>');
+  AStrings.Add('<!-- Created with fpVectorial (http://wiki.lazarus.freepascal.org/fpvectorial) -->');
+  AStrings.Add('');
+  AStrings.Add('<svg');
+  AStrings.Add('  xmlns:dc="http://purl.org/dc/elements/1.1/"');
+  AStrings.Add('  xmlns:cc="http://creativecommons.org/ns#"');
+  AStrings.Add('  xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"');
+  AStrings.Add('  xmlns:svg="http://www.w3.org/2000/svg"');
+  AStrings.Add('  xmlns="http://www.w3.org/2000/svg"');
+  AStrings.Add('  xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd"');
+  WriteDocumentSize(AStrings, AData);
+  AStrings.Add('  id="svg2"');
+  AStrings.Add('  version="1.1"');
+  WriteDocumentName(AStrings, AData);
+
+  // Now data
+  AStrings.Add('  <g id="layer1">');
+  WritePaths(AStrings, AData);
+  AStrings.Add('  </g>');
+
+  // finalization
+  AStrings.Add('</svg>');
+end;
+
+initialization
+
+  RegisterVectorialWriter(TvSVGVectorialWriter, vfSVG);
+
+end.
+

packages/x11/src/xlib.pp

@@ -1252,9 +1252,10 @@ type
      _Xdebug : cint;cvar;external;
 {$endif}
 type
-  funcdisp = function(display:PDisplay):cint;cdecl;
+  funcdisp    = function(display:PDisplay):cint;cdecl;
   funcifevent = function(display:PDisplay; event:PXEvent; p : TXPointer):TBoolResult;cdecl;
-  chararr32 = array[0..31] of char;
+  chararr32   = array[0..31] of char;
+  pchararr32  = chararr32;
 
 const
   AllPlanes : culong = culong(not 0);
@@ -1571,7 +1572,7 @@ function XQueryColor(para1:PDisplay; para2:TColormap; para3:PXColor):cint;cdecl;
 function XQueryColors(para1:PDisplay; para2:TColormap; para3:PXColor; para4:cint):cint;cdecl;external libX11;
 function XQueryExtension(para1:PDisplay; para2:Pchar; para3:Pcint; para4:Pcint; para5:Pcint):TBoolResult;cdecl;external libX11;
 {?}
-function XQueryKeymap(para1:PDisplay; para2:chararr32):cint;cdecl;external libX11;
+function XQueryKeymap(para1:PDisplay; para2:pchararr32):cint;cdecl;external libX11;
 function XQueryPointer(para1:PDisplay; para2:TWindow; para3:PWindow; para4:PWindow; para5:Pcint;
            para6:Pcint; para7:Pcint; para8:Pcint; para9:Pcuint):TBoolResult;cdecl;external libX11;
 function XQueryTextExtents(para1:PDisplay; para2:TXID; para3:Pchar; para4:cint; para5:Pcint;

rtl/objpas/dateutil.inc

@@ -1530,8 +1530,14 @@ end;
 
 Procedure DecodeDateTime(const AValue: TDateTime; out AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word);
 begin
-  DecodeDate(AValue,AYear,AMonth,ADay);
   DecodeTime(AValue,AHour,AMinute,ASecond,AMilliSecond);
+  if AHour=24 then // can happen due rounding issues mantis 17123
+    begin
+      AHour:=0; // rest is already zero
+      DecodeDate(round(AValue),AYear,AMonth,ADay);
+    end
+  else
+    DecodeDate(AValue,AYear,AMonth,ADay);
 end;
 
 

rtl/win/sysutils.pp

@@ -60,6 +60,7 @@ Procedure RaiseLastWin32Error;
 function GetFileVersion(const AFileName: string): Cardinal;
 
 procedure GetFormatSettings;
+procedure GetLocaleFormatSettings(LCID: Integer; var FormatSettings: TFormatSettings); platform;
 
 implementation
 
@@ -651,49 +652,56 @@ Begin
 End;
 
 
-procedure GetFormatSettings;
+procedure GetLocaleFormatSettings(LCID: Integer; var FormatSettings: TFormatSettings); 
 var
   HF  : Shortstring;
-  LID : LCID;
+  LID : Windows.LCID;
   I,Day : longint;
 begin
-  LID := GetThreadLocale;
-  { Date stuff }
-  for I := 1 to 12 do
-    begin
-    ShortMonthNames[I]:=GetLocaleStr(LID,LOCALE_SABBREVMONTHNAME1+I-1,ShortMonthNames[i]);
-    LongMonthNames[I]:=GetLocaleStr(LID,LOCALE_SMONTHNAME1+I-1,LongMonthNames[i]);
-    end;
-  for I := 1 to 7 do
+  LID := LCID;
+  with FormatSettings do
     begin
-    Day := (I + 5) mod 7;
-    ShortDayNames[I]:=GetLocaleStr(LID,LOCALE_SABBREVDAYNAME1+Day,ShortDayNames[i]);
-    LongDayNames[I]:=GetLocaleStr(LID,LOCALE_SDAYNAME1+Day,LongDayNames[i]);
+  { Date stuff }
+      for I := 1 to 12 do
+        begin
+        ShortMonthNames[I]:=GetLocaleStr(LID,LOCALE_SABBREVMONTHNAME1+I-1,ShortMonthNames[i]);
+        LongMonthNames[I]:=GetLocaleStr(LID,LOCALE_SMONTHNAME1+I-1,LongMonthNames[i]);
+        end;
+      for I := 1 to 7 do
+        begin
+        Day := (I + 5) mod 7;
+        ShortDayNames[I]:=GetLocaleStr(LID,LOCALE_SABBREVDAYNAME1+Day,ShortDayNames[i]);
+        LongDayNames[I]:=GetLocaleStr(LID,LOCALE_SDAYNAME1+Day,LongDayNames[i]);
+        end;
+      DateSeparator := GetLocaleChar(LID, LOCALE_SDATE, '/');
+      ShortDateFormat := GetLocaleStr(LID, LOCALE_SSHORTDATE, 'm/d/yy');
+      LongDateFormat := GetLocaleStr(LID, LOCALE_SLONGDATE, 'mmmm d, yyyy');
+      { Time stuff }
+      TimeSeparator := GetLocaleChar(LID, LOCALE_STIME, ':');
+      TimeAMString := GetLocaleStr(LID, LOCALE_S1159, 'AM');
+      TimePMString := GetLocaleStr(LID, LOCALE_S2359, 'PM');
+      if StrToIntDef(GetLocaleStr(LID, LOCALE_ITLZERO, '0'), 0) = 0 then
+        HF:='h'
+      else
+        HF:='hh';
+      // No support for 12 hour stuff at the moment...
+      ShortTimeFormat := HF+':nn';
+      LongTimeFormat := HF + ':nn:ss';
+      { Currency stuff }
+      CurrencyString:=GetLocaleStr(LID, LOCALE_SCURRENCY, '');
+      CurrencyFormat:=StrToIntDef(GetLocaleStr(LID, LOCALE_ICURRENCY, '0'), 0);
+      NegCurrFormat:=StrToIntDef(GetLocaleStr(LID, LOCALE_INEGCURR, '0'), 0);
+      { Number stuff }
+      ThousandSeparator:=GetLocaleChar(LID, LOCALE_STHOUSAND, ',');
+      DecimalSeparator:=GetLocaleChar(LID, LOCALE_SDECIMAL, '.');
+      CurrencyDecimals:=StrToIntDef(GetLocaleStr(LID, LOCALE_ICURRDIGITS, '0'), 0);
     end;
-  DateSeparator := GetLocaleChar(LID, LOCALE_SDATE, '/');
-  ShortDateFormat := GetLocaleStr(LID, LOCALE_SSHORTDATE, 'm/d/yy');
-  LongDateFormat := GetLocaleStr(LID, LOCALE_SLONGDATE, 'mmmm d, yyyy');
-  { Time stuff }
-  TimeSeparator := GetLocaleChar(LID, LOCALE_STIME, ':');
-  TimeAMString := GetLocaleStr(LID, LOCALE_S1159, 'AM');
-  TimePMString := GetLocaleStr(LID, LOCALE_S2359, 'PM');
-  if StrToIntDef(GetLocaleStr(LID, LOCALE_ITLZERO, '0'), 0) = 0 then
-    HF:='h'
-  else
-    HF:='hh';
-  // No support for 12 hour stuff at the moment...
-  ShortTimeFormat := HF+':nn';
-  LongTimeFormat := HF + ':nn:ss';
-  { Currency stuff }
-  CurrencyString:=GetLocaleStr(LID, LOCALE_SCURRENCY, '');
-  CurrencyFormat:=StrToIntDef(GetLocaleStr(LID, LOCALE_ICURRENCY, '0'), 0);
-  NegCurrFormat:=StrToIntDef(GetLocaleStr(LID, LOCALE_INEGCURR, '0'), 0);
-  { Number stuff }
-  ThousandSeparator:=GetLocaleChar(LID, LOCALE_STHOUSAND, ',');
-  DecimalSeparator:=GetLocaleChar(LID, LOCALE_SDECIMAL, '.');
-  CurrencyDecimals:=StrToIntDef(GetLocaleStr(LID, LOCALE_ICURRDIGITS, '0'), 0);
 end;
 
+procedure GetFormatSettings;
+begin
+  GetlocaleFormatSettings(GetThreadLocale, DefaultFormatSettings);
+end;
 
 Procedure InitInternational;
 var