Merged revisions 8534-8537,8539-8546,8554,8560,8569,8575-8576,8581-8587,8590,8593-8594,8596,8600,8605,8607,8611,8625,8630-8638,8640-8641,8644,8648-8649,8659,8661,8665,8667,8681-8682,8686-8687,8702,8705,8710-8714,8719,8721-8723,8726-8728,8730-8732,8736,8743,8745-8753,8757-8760,8762-8764,8766-8769,8782-8783,8795,8797,8822,8831,8843,8845,8848-8849,8851,8856,8859,8861,8863,8871,8876-8877,8879-8889,8891-8897,8912-8914,8916-8917,8922,8924,8928,8930,8934,8940,8942,8950,8955,8973,8976-8977,8983-8984,8996,8998,9000-9007 via svnmerge from

http://svn.freepascal.org/svn/fpc/trunk

........
  r8534 | joost | 2007-09-17 23:25:51 +0200 (Mon, 17 Sep 2007) | 1 line
  
  * Changed MinDateTime for FloatToDateTime and VariantToDate to 01/01/0001
........
  r8569 | joost | 2007-09-20 16:36:50 +0200 (Thu, 20 Sep 2007) | 1 line
  
   * Added missing isc_event_counts to ibase60dyn
........
  r8611 | michael | 2007-09-23 11:20:30 +0200 (Sun, 23 Sep 2007) | 1 line
  
  * New version corresponding to 1.0.17 from Ido Kanner
........
  r8644 | Almindor | 2007-09-26 00:06:07 +0200 (Wed, 26 Sep 2007) | 3 lines
  
  * use cInt instead of Integer and cuLong instead of Cardinal (latter confirmed with .h)
  * NOTE: requires proper check againt .h since docs are missing, but the .h are messy
........
  r8648 | pierre | 2007-09-26 01:28:02 +0200 (Wed, 26 Sep 2007) | 2 lines
  
    * save stop_break_number and restore at end of gdb_command method
    + add support for DEBUG_FILE_DIRECTORY
........
  r8649 | Almindor | 2007-09-26 13:49:00 +0200 (Wed, 26 Sep 2007) | 2 lines
  
  * fix few cases of misplaced cInt (should be cLong)
........
  r8661 | Almindor | 2007-09-27 10:37:25 +0200 (Thu, 27 Sep 2007) | 2 lines
  
  * fix cInt -> cLong changes in implementation section too
........
  r8726 | joost | 2007-10-02 23:01:13 +0200 (Tue, 02 Oct 2007) | 1 line
  
   * Terminate strings in recordbuffer if size of supplied string is larger then the field-size
........
  r8728 | joost | 2007-10-03 10:26:43 +0200 (Wed, 03 Oct 2007) | 1 line
  
   * Patch from Jesus Reyes with better fix for r8726
........
  r8732 | marco | 2007-10-04 18:26:09 +0200 (Thu, 04 Oct 2007) | 2 lines
  
   * patch a few stdcalls
........
  r8736 | marco | 2007-10-07 09:33:14 +0200 (Sun, 07 Oct 2007) | 2 lines
  
   * fixed 9868 typo
........
  r8745 | joost | 2007-10-08 12:00:28 +0200 (Mon, 08 Oct 2007) | 1 line
  
   * some fixes for queries with more then 10 parameters + tests
........
  r8746 | joost | 2007-10-08 12:24:28 +0200 (Mon, 08 Oct 2007) | 1 line
  
   * =,+,-,*,\,\,[,] added to param name delimiters (patch based on mseide-msegui)
........
  r8752 | joost | 2007-10-08 23:24:01 +0200 (Mon, 08 Oct 2007) | 1 line
  
   * Fix for empty searchstrings in stringsreplace
........
  r8753 | joost | 2007-10-09 10:50:40 +0200 (Tue, 09 Oct 2007) | 1 line
  
   * Changed library-initialisation. It now works the same as for mysql. Fixes bug #9546
........
  r8757 | michael | 2007-10-09 23:12:04 +0200 (Tue, 09 Oct 2007) | 1 line
  
  * Made FRunning and FExitCode protected
........
  r8758 | jonas | 2007-10-10 14:42:12 +0200 (Wed, 10 Oct 2007) | 2 lines
  
    * fixed compilation
........
  r8759 | joost | 2007-10-10 17:50:03 +0200 (Wed, 10 Oct 2007) | 4 lines
  
   Patch from Zaher Dirkey (modified)
   * Set Sqlite3Lib on WinCE
   * In dynamic lib, sqlite3_version must be aliased as like in static lib to sqlite3_libversion
   * sqlite3_version function must called with the () at last, because sqlite3_version pointer to function
........
  r8760 | marco | 2007-10-10 18:26:43 +0200 (Wed, 10 Oct 2007) | 2 lines
  
   * Fixed for 9879
........
  r8762 | pierre | 2007-10-11 18:40:21 +0200 (Thu, 11 Oct 2007) | 3 lines
  
    + defines for GDB 6.7
    + USE_MINGW_GDB define added to test mingw32 GDB port
........
  r8763 | pierre | 2007-10-11 18:41:06 +0200 (Thu, 11 Oct 2007) | 1 line
  
   *call destructor at exit
........
  r8764 | Almindor | 2007-10-11 18:58:31 +0200 (Thu, 11 Oct 2007) | 2 lines
  
  * fix record sizes to use packrecords C in vorbis (bug 9867)
........
  r8782 | michael | 2007-10-13 22:29:09 +0200 (Sat, 13 Oct 2007) | 1 line
  
  * Quotes are normally not stripped. Introduced a StripQuotes property
........
  r8783 | florian | 2007-10-14 00:13:47 +0200 (Sun, 14 Oct 2007) | 2 lines
  
  * basic TComObject implementation
........
  r8795 | florian | 2007-10-14 16:15:48 +0200 (Sun, 14 Oct 2007) | 2 lines
  
  * fpu safe glut by Jan Bruns, resolves #8995
........
  r8843 | joost | 2007-10-18 22:45:10 +0200 (Thu, 18 Oct 2007) | 1 line
  
   * Patch from Andrey Gusev to implement TSQLQuery.GetRowsaffected + test
........
  r8845 | florian | 2007-10-18 23:25:31 +0200 (Thu, 18 Oct 2007) | 2 lines
  
  * fixes IDataObject declaration, resolves #9966
........
  r8856 | joost | 2007-10-20 00:07:56 +0200 (Sat, 20 Oct 2007) | 2 lines
  
   * Added checks to TField.Size
   * Cleanup and several fixes regarding TField.Size in IBconnection
........
  r8859 | joost | 2007-10-20 00:38:35 +0200 (Sat, 20 Oct 2007) | 1 line
  
   * Trim stringfields longer then dsMaxStringSize in IBConnection + test. (bug 9600)
........
  r8861 | joost | 2007-10-20 14:16:24 +0200 (Sat, 20 Oct 2007) | 1 line
  
   * Removed unnecessary "as" calls, added class-type checks in SetDatabase
........
  r8863 | joost | 2007-10-20 18:58:50 +0200 (Sat, 20 Oct 2007) | 1 line
  
   * Deleted ibase60.h
........
  r8871 | joost | 2007-10-21 11:19:35 +0200 (Sun, 21 Oct 2007) | 4 lines
  
   * Added ftCurrency and ftBCD-fields tests
   * Renamed testname which was too long for testsuite-database
   * Fixed some TFiels.Size issues with postgres
   * Added money support to TPQConnection
........
  r8876 | marco | 2007-10-21 13:23:12 +0200 (Sun, 21 Oct 2007) | 1 line
  
   * sqlhandle type changed to pointer. Fixed demo.
........
  r8877 | joost | 2007-10-21 13:24:26 +0200 (Sun, 21 Oct 2007) | 1 line
  
   * Implemented TIBConnection.RowsAffected
........
  r8880 | joost | 2007-10-21 15:29:28 +0200 (Sun, 21 Oct 2007) | 2 lines
  
   * Fixed TestSupportLargeintFields
   * Disabled TestBug9744 for Interbase/firebird
........
  r8881 | joost | 2007-10-21 15:39:18 +0200 (Sun, 21 Oct 2007) | 1 line
  
   * Fixed bug #9342 as suggested by reporter Sergey Smirnov
........
  r8882 | marco | 2007-10-21 15:40:42 +0200 (Sun, 21 Oct 2007) | 2 lines
  
   * tdbf now also for non-x86
........
  r8883 | micha | 2007-10-21 15:51:12 +0200 (Sun, 21 Oct 2007) | 1 line
  
  * update tdbf to 6.9.2
........
  r8884 | marco | 2007-10-21 15:58:06 +0200 (Sun, 21 Oct 2007) | 2 lines
  
   * Fix for regclosekey problem.
........
  r8894 | joost | 2007-10-21 17:57:10 +0200 (Sun, 21 Oct 2007) | 1 line
  
   * Define ISC_STATUS as clong, instead of longint
........
  r8896 | michael | 2007-10-21 18:09:41 +0200 (Sun, 21 Oct 2007) | 24 lines
  
  * Patch by Sergei Gorelkin:
    xmlread.pp:
    * As a step towards SAX-based validation, element content validator is
    rewritten from scratch, so it now accepts child elements one by
    one. This also enables reporting location of validation errors (however,
    most locations aren't reported correctly yet).
    * More straightforward handling of comments and PIs in internal subset.
    * Attribute text is handled separately from element text.
    * Unified handling of fatal and validation errors.
  
    xmlutils.pp:
    * Removed auto widechar->char conversions. These should have been a part
    of fix for #9528, but were not noticed at that moment.
  
    dom.pp:
    * Reworked 'ugly workarounds' in node removal code.
    + Element nodes remove themselves from document list of IDs, so no invalid pointers are left around.
  
    xmlts.pp:
    * Corrected validation diagnostics (display the first message and ingore subsequent ones).
    * Validation error alone in a not-well-formed case is a test failure.
........
  r8913 | joost | 2007-10-23 13:40:43 +0200 (Tue, 23 Oct 2007) | 5 lines
  
   * TIBConnection.Dialect is read-only as it is implemened now. And public, not published. 
   * Check if the database is connected in TIBConnection.SetDialect
   * Changed error-buffer size (ibconnection)
   * TCustomConnection.StreamedConnected is protected
   * Initialize TDatabase.FConnected to false
........
  r8914 | joost | 2007-10-23 13:45:40 +0200 (Tue, 23 Oct 2007) | 1 line
  
   * Allow a size of 0 in a stringfield
........
  r8916 | florian | 2007-10-23 19:50:48 +0200 (Tue, 23 Oct 2007) | 1 line
  
  + initial FlatSB implementation, resolves #7915
........
  r8922 | michael | 2007-10-24 10:55:50 +0200 (Wed, 24 Oct 2007) | 1 line
  
  * Avoid a size 0 error on empty string fields
........
  r8924 | joost | 2007-10-24 23:05:05 +0200 (Wed, 24 Oct 2007) | 1 line
  
   * Patch from Jesus Reyes to allow changing the Dialect
........
  r8928 | joost | 2007-10-25 21:05:34 +0200 (Thu, 25 Oct 2007) | 1 line
  
   * Patch from Jesus Reyes to avoid that all fields are treated as blobs
........
  r8930 | peter | 2007-10-25 21:25:14 +0200 (Thu, 25 Oct 2007) | 2 lines
  
    * remove Contnrs unit dependency by using TFPList instead of TFPObjectList
........
  r8934 | joost | 2007-10-25 21:59:34 +0200 (Thu, 25 Oct 2007) | 1 line
  
   * TestExceptOnsecClose does now really test all connections
........
  r8940 | joost | 2007-10-25 22:41:20 +0200 (Thu, 25 Oct 2007) | 1 line
  
   * Call GetDBDialect in DoConnect since in DoInternalConnect Connected is false, so GetDBDialect effectively does nothing
........
  r8955 | marco | 2007-10-27 19:27:30 +0200 (Sat, 27 Oct 2007) | 2 lines
  
   * fix for 10027 Some missing pango stuff
........
  r8973 | joost | 2007-10-28 17:53:48 +0100 (Sun, 28 Oct 2007) | 1 line
  
   * Ignore tests which are not applicable when firebird is tested
........
  r8976 | joost | 2007-10-28 20:32:12 +0100 (Sun, 28 Oct 2007) | 3 lines
  
   * Implemented TPQConnection.RowsAffected
   * Improved test for RowsAffected
   * TIBConnection.RowsAffected now returns -1 on failure
........
  r8977 | joost | 2007-10-28 21:38:50 +0100 (Sun, 28 Oct 2007) | 2 lines
  
   * Truncate strings longer then dsMaxStringSize
   * Cleaned up some unnecessary calls
........
  r8983 | joost | 2007-10-28 23:13:20 +0100 (Sun, 28 Oct 2007) | 3 lines
  
   * TestBug9744 disabled for Postgresql too
   * GetindexDefs-tests case-insensitive
   * Removed writeln from test
........
  r8984 | joost | 2007-10-28 23:14:12 +0100 (Sun, 28 Oct 2007) | 1 line
  
   * Set the field-size of a numeric field correctly if it is undefined
........
  r8996 | peter | 2007-10-30 08:06:42 +0100 (Tue, 30 Oct 2007) | 2 lines
  
    * fix compile with 2.0
........
  r9007 | jonas | 2007-10-30 13:28:24 +0100 (Tue, 30 Oct 2007) | 2 lines
  
    - removed svn:executable
........

git-svn-id: branches/fixes_2_2@9025 -

.gitattributes

@@ -933,7 +933,6 @@ packages/base/ibase/README -text
 packages/base/ibase/fpmake.inc svneol=native#text/plain
 packages/base/ibase/fpmake.pp svneol=native#text/plain
 packages/base/ibase/ibase40.pp svneol=native#text/plain
-packages/base/ibase/ibase60.h -text
 packages/base/ibase/ibase60.inc svneol=native#text/plain
 packages/base/ibase/ibase60.pp svneol=native#text/plain
 packages/base/ibase/ibase60dyn.pp svneol=native#text/plain
@@ -1504,6 +1503,7 @@ packages/base/winunits/examples/OOTest.pp -text svneol=unset#text/plain
 packages/base/winunits/examples/testcom1.pp svneol=native#text/plain
 packages/base/winunits/examples/testcom2.pp svneol=native#text/plain
 packages/base/winunits/examples/testver.pp svneol=native#text/plain
+packages/base/winunits/flatsb.pp svneol=native#text/plain
 packages/base/winunits/fpmake.inc svneol=native#text/plain
 packages/base/winunits/fpmake.pp svneol=native#text/plain
 packages/base/winunits/jedi.inc svneol=native#text/plain

packages/base/gdbint/gdbint.pp

@@ -71,6 +71,17 @@ interface
   {$define GDB_HAS_DB_COMMANDS}
   {$define GDB_NEEDS_NO_ERROR_INIT}
   {$define GDB_USES_EXPAT_LIB}
+  {$define GDB_HAS_DEBUG_FILE_DIRECTORY}
+{$endif def GDB_V605}
+
+{ 6.7.x }
+{$ifdef GDB_V607}
+  {$info using gdb 6.7.x}
+  {$define GDB_V6}
+  {$define GDB_HAS_DB_COMMANDS}
+  {$define GDB_NEEDS_NO_ERROR_INIT}
+  {$define GDB_USES_EXPAT_LIB}
+  {$define GDB_HAS_DEBUG_FILE_DIRECTORY}
 {$endif def GDB_V605}
 
 {$ifdef GDB_V6}
@@ -207,14 +218,24 @@ interface
   {$LINKLIB libhistory.a}
   {$LINKLIB libiberty.a}
   {$LINKLIB libintl.a}
-  {$LINKLIB libiconv.a}
-  {$LINKLIB libncurses.a}
-  {$ifdef GDB_USES_EXPAT_LIB}
-    {$LINKLIB expat}
-  {$endif GDB_USES_EXPAT_LIB}
-  {$LINKLIB gcc}
-  {$LINKLIB cygwin} { alias of libm.a and libc.a }
+  {$ifdef USE_MINGW_GDB}
+    {$LINKLIB libm.a}
+    {$LINKLIB libmoldname.a}
+    {$LINKLIB libgcc.a}
+    {$LINKLIB libws2_32.a}
+    {$LINKLIB libmingwex.a}
+    {$LINKLIB libmingw32.a}
+    {$LINKLIB libmsvcrt.a}
+  {$else not USE_MINGW_GDB}
+    {$LINKLIB libiconv.a}
+    {$LINKLIB libncurses.a}
+    {$ifdef GDB_USES_EXPAT_LIB}
+      {$LINKLIB expat}
+    {$endif GDB_USES_EXPAT_LIB}
+    {$LINKLIB gcc}
+    {$LINKLIB cygwin} { alias of libm.a and libc.a }
   {$LINKLIB imagehlp}
+  {$endif not USE_MINGW_GDB}	
   {$LINKLIB kernel32}
   {$LINKLIB user32}
 {$endif win32}
@@ -504,7 +525,10 @@ implementation
 
 uses
 {$ifdef win32}
-  initc,
+  {$ifdef USE_MINGW_GDB}
+  {$else not USE_MINGW_GDB}
+    initc,
+  {$endif not USE_MINGW_GDB}
 {$endif win32}
 {$ifdef unix}
   baseunix,
@@ -549,10 +573,19 @@ type
   end;
 
   pjmp_buf = ^jmp_buf;
-
+{$ifdef USE_MINGW_GDB}
+  { for obscure reasons, longjmp and _setjmp are defined in mingw32 libmsvcrt.a }
+  function _setjmp(var rec : jmp_buf) : longint; cdecl; external;
+  procedure longjmp(var rec : jmp_buf;return_value : longint); cdecl; external;
+  function setjmp(var rec : jmp_buf) : longint;
+    begin
+	  setjmp:=_setjmp(rec);
+	end;
+{$else not USE_MINGW_GDB}
   function setjmp(var rec : jmp_buf) : longint;cdecl;external;
 
   procedure longjmp(var rec : jmp_buf;return_value : longint);cdecl;external;
+{$endif not USE_MINGW_GDB}
 
 {$ifndef supportexceptions}
 type
@@ -2175,6 +2208,7 @@ end;
 procedure tgdbinterface.gdb_command(const s:string);
 var
   command          : array[0..256] of char;
+  prev_stop_breakpoint_number,
   mask : longint;
   s2 : string;
   old_quit_return,
@@ -2190,6 +2224,11 @@ begin
   old_error_return:=error_return;
   gdb_error:=0;
   got_error:=false;
+  if command_level=1 then
+    prev_stop_breakpoint_number:=0
+  else
+    prev_stop_breakpoint_number:=stop_breakpoint_number;
+
   stop_breakpoint_number:=0;
   { Trap quit commands }
   s2:=s;
@@ -2237,6 +2276,7 @@ begin
   quit_return:=old_quit_return;
   error_return:=old_error_return;
   dec(command_level);
+  stop_breakpoint_number:=prev_stop_breakpoint_number;
   SetFPUState(control);
 end;
 
@@ -2562,12 +2602,19 @@ var gdb_sysroot  : pchar; cvar;public;
     return_child_result_value : longint;cvar;public;
     batch_silent : longbool;cvar;public;
 {$endif}
+{$ifdef GDB_HAS_DEBUG_FILE_DIRECTORY}
+var
+  debug_file_directory : pchar; cvar; external;
+{$endif GDB_HAS_DEBUG_FILE_DIRECTORY}
 
 begin
 {$ifdef GDB_HAS_SYSROOT}
   gdb_sysrootc := #0;
   gdb_sysroot := @gdb_sysrootc;
 {$endif}
+{$ifdef GDB_HAS_DEBUG_FILE_DIRECTORY}
+  debug_file_directory := '/usr/local/lib';
+{$endif GDB_HAS_DEBUG_FILE_DIRECTORY}
   gdb_stderr:=nil;
   gdb_stdout:=nil;
   InitLibGDB;

packages/base/gdbint/testgdb.pp

@@ -50,5 +50,6 @@ begin
        last:=s;
      end;
   until false;
+  gdb.done;
   Writeln('End of pascal GDB...');
 end.

packages/base/ibase/ibase60.h

@@ -1,2657 +0,0 @@
-/*
- *	MODULE:		ibase.h
- *	DESCRIPTION:	OSRI entrypoints and defines
- *
- * copyright (c) 1998, 1999 by InterBase Software Corporation
- */
-
-#ifndef _JRD_IBASE_H_
-#define _JRD_IBASE_H_
-
-#ifndef HARBOR_MERGE
-#define HARBOR_MERGE
-#endif
-
-#define isc_version4
-
-#define  ISC_TRUE	1
-#define  ISC_FALSE	0
-#if !(defined __cplusplus)
-#define  ISC__TRUE	ISC_TRUE
-#define  ISC__FALSE	ISC_FALSE
-#endif
-
-
-/*!!MVC
-#define  ISC_USHORT	unsigned short
-#define  ISC_STATUS	long
-!!MVC*/
-
-#define  DSQL_close     1
-#define  DSQL_drop      2
-
-
-/******************************************************************/
-/* Define type, export and other stuff based on c/c++ and Windows */
-/******************************************************************/
-
-/*!!MVC
-#if (defined(_MSC_VER) && defined(_WIN32)) || \
-    (defined(__BORLANDC__) && (defined(__WIN32__) || defined(__OS2__)))
-#define  ISC_FAR
-#define  ISC_EXPORT	__stdcall
-#define  ISC_EXPORT_VARARG	__cdecl
-typedef           __int64  ISC_INT64;
-typedef  unsigned __int64  ISC_UINT64;
-#define  ISC_INT64_DEFINED
-#else					
-#if (defined(__IBMC__) && defined(__OS2__))
-#define  ISC_FAR
-#define  ISC_EXPORT	_System
-#define  ISC_EXPORT_VARARG	ISC_EXPORT
-#else					
-#if ( defined( _Windows) || defined( _WINDOWS))
-#define  ISC_FAR	__far
-#define  ISC_EXPORT     ISC_FAR __cdecl __loadds __export
-#define  ISC_EXPORT_VARARG	ISC_EXPORT
-#else					
-#define  ISC_FAR
-#define  ISC_EXPORT
-#define  ISC_EXPORT_VARARG
-#endif
-#endif
-#endif
-!!MVC*/
-
-/*!!MVC
-  Removed all ISC_FAR, ISC_EXPORT_VARARG and ISC_EXPORT 
-  macros. 
-  They confuse h2pas...
-!!MVC*/
-
-/*******************************************************************/
-/* 64 bit Integers                                                 */
-/*******************************************************************/
-
-/*!!MVC
-#ifndef  ISC_INT64_DEFINED              
-typedef           long long int  ISC_INT64;	
-typedef  unsigned long long int  ISC_UINT64;	
-#else
-#undef  ISC_INT64_DEFINED
-#endif
-!!MVC*/
-
-/*******************************************************************/
-/* Time & Date Support                                             */
-/*******************************************************************/
-
-#ifndef _ISC_TIMESTAMP_
-typedef long		ISC_DATE;
-typedef unsigned long	ISC_TIME;
-typedef struct {
-    ISC_DATE 	timestamp_date;
-    ISC_TIME	timestamp_time;
-} ISC_TIMESTAMP;
-#define _ISC_TIMESTAMP_			1
-#endif
-
-#define ISC_TIME_SECONDS_PRECISION          10000L
-#define ISC_TIME_SECONDS_PRECISION_SCALE    -4
-
-/*******************************************************************/
-/* Blob id structure                                               */
-/*******************************************************************/
-
-/*!!MVC
-typedef struct {
-    ISC_LONG		gds_quad_high;
-    unsigned ISC_LONG	gds_quad_low;
-} GDS_QUAD;
-!!MVC*/
-
-#if !(defined __cplusplus)
-typedef GDS_QUAD	GDS__QUAD;
-#endif					/* !(defined __cplusplus) */
-
-#define	ISC_QUAD	GDS_QUAD
-#define	isc_quad_high	gds_quad_high
-#define	isc_quad_low	gds_quad_low
-
-typedef struct {
-    short       	array_bound_lower;
-    short       	array_bound_upper;
-} ISC_ARRAY_BOUND;
-
-typedef struct {
-    unsigned char       array_desc_dtype;
-    char                array_desc_scale;
-    unsigned short      array_desc_length;
-    char                array_desc_field_name [32];
-    char                array_desc_relation_name [32];
-    short               array_desc_dimensions;
-    short               array_desc_flags;
-    ISC_ARRAY_BOUND     array_desc_bounds [16];
-} ISC_ARRAY_DESC;
-
-typedef struct {
-    short               blob_desc_subtype;
-    short               blob_desc_charset;
-    short               blob_desc_segment_size;
-    unsigned char       blob_desc_field_name [32];
-    unsigned char       blob_desc_relation_name [32];
-} ISC_BLOB_DESC;
-
-
-/***************************/
-/* Blob control structure  */
-/***************************/
-
-typedef struct isc_blob_ctl{
-/*!!MVC
-    ISC_STATUS      ( *ctl_source)();
-!!MVC*/    	/* Source filter */
-/*!!MVC
-    struct isc_blob_ctl  *ctl_source_handle; 
-!!MVC*/ /* Argument to pass to source */
-						/* filter */
-    short		  ctl_to_sub_type;  	/* Target type */
-    short		  ctl_from_sub_type;	/* Source type */
-    unsigned short  	  ctl_buffer_length;	/* Length of buffer */
-    unsigned short  	  ctl_segment_length;  	/* Length of current segment */
-    unsigned short  	  ctl_bpb_length;	/* Length of blob parameter */
-					    	/* block */
-    char	   *ctl_bpb;		/* Address of blob parameter */ 
-						/* block */
-    unsigned char  *ctl_buffer;		/* Address of segment buffer */
-    ISC_LONG     	  ctl_max_segment;	/* Length of longest segment */
-    ISC_LONG	 	  ctl_number_segments; 	/* Total number of segments */
-    ISC_LONG  		  ctl_total_length;  	/* Total length of blob */
-    ISC_STATUS	   *ctl_status;		/* Address of status vector */
-    long		  ctl_data [8];	  	/* Application specific data */
-}  *ISC_BLOB_CTL;
-
-/***************************/
-/* Blob stream definitions */ 
-/***************************/
-
-typedef struct bstream {
-    void	 *bstr_blob;  	/* Blob handle */
-    char	 *bstr_buffer;	/* Address of buffer */
-    char	 *bstr_ptr;	/* Next character */
-    short	  bstr_length;		/* Length of buffer */
-    short	  bstr_cnt;		/* Characters in buffer */
-    char      	  bstr_mode;  		/* (mode) ? OUTPUT : INPUT */
-} BSTREAM;
-
-/*!!MVC
-
-#define getb(p)	(--(p)->bstr_cnt >= 0 ? *(p)->bstr_ptr++ & 0377: BLOB_get (p))
-#define putb(x,p) (((x) == '\n' || (!(--(p)->bstr_cnt))) ? BLOB_put ((x),p) : ((int) (*(p)->bstr_ptr++ = (unsigned) (x))))
-#define putbx(x,p) ((!(--(p)->bstr_cnt)) ? BLOB_put ((x),p) : ((int) (*(p)->bstr_ptr++ = (unsigned) (x))))
-
-!!MVC */
-
-/***************************/
-/* Dynamic SQL definitions */
-/***************************/
- 
-/******************************/
-/* Declare the extended SQLDA */
-/******************************/
-
-typedef struct {
-    short	sqltype;		/* datatype of field */
-    short	sqlscale;		/* scale factor */
-    short	sqlsubtype;		/* datatype subtype - BLOBs & Text */
-					/* types only */
-    short	sqllen;			/* length of data area */
-    char   *sqldata;		/* address of data */
-    short  *sqlind;		/* address of indicator variable */
-    short  	sqlname_length;		/* length of sqlname field */
-    char	sqlname [32];		/* name of field, name length + space */
-					/* for NULL */
-    short	relname_length;		/* length of relation name */
-    char	relname [32];		/* field's relation name + space for */
-					/* NULL */
-    short	ownname_length;		/* length of owner name */
-    char	ownname [32];		/* relation's owner name + space for */
-					/* NULL */
-    short	aliasname_length; 	/* length of alias name */
-    char	aliasname [32];		/* relation's alias name + space for */
-					/* NULL */
-} XSQLVAR;
-
-typedef struct {
-    short	version;		/* version of this XSQLDA */
-    char	sqldaid [8];		/* XSQLDA name field */
-    ISC_LONG	sqldabc;		/* length in bytes of SQLDA */
-    short	sqln;			/* number of fields allocated */
-    short	sqld;			/* actual number of fields */
-    XSQLVAR	sqlvar [1];		/* first field address */
-} XSQLDA;
-
-#define XSQLDA_LENGTH(n)	(sizeof (XSQLDA) + ((n)-1) * sizeof (XSQLVAR))
-
-#define SQLDA_VERSION1			1
-
-#define SQL_DIALECT_V5			1/* meaning is same as DIALECT_xsqlda */
-#define SQL_DIALECT_V6_TRANSITION	2/* flagging anything that is delimited
-                                            by double quotes as an error and
-                                            flagging keyword DATE as an error */
-#define SQL_DIALECT_V6			3/* supports SQL delimited identifier,
-                                            SQLDATE/DATE, TIME, TIMESTAMP,
-                                            CURRENT_DATE, CURRENT_TIME,
-                                            CURRENT_TIMESTAMP, and 64-bit exact
-                                            numeric type */
-#define SQL_DIALECT_CURRENT		SQL_DIALECT_V6/* latest IB DIALECT */
-
-/********************************/
-/* InterBase Handle Definitions */
-/********************************/
-
-typedef void      *isc_att_handle;
-
-typedef void      *isc_blob_handle;
-typedef void      *isc_db_handle;
-typedef void      *isc_form_handle;
-typedef void      *isc_req_handle;
-typedef void      *isc_stmt_handle;
-typedef void      *isc_svc_handle;
-typedef void      *isc_tr_handle;
-typedef void      *isc_win_handle;
-typedef void    ( *isc_callback)();
-typedef ISC_LONG	 isc_resv_handle;
-
-/***************************/
-/* OSRI database functions */
-/***************************/
-
-/*!!MVC
-#if defined(__cplusplus) || defined(__STDC__) || defined(_Windows) || \
-    (defined(_MSC_VER) && defined(WIN32)) || defined( _WINDOWS) || \
-    (defined(__BORLANDC__) && (defined(__WIN32__) || defined(__OS2__))) || \
-    (defined(__IBMC__) && defined(__OS2__)) || defined(AIX_PPC)
-
-#ifdef __cplusplus
-extern "C" {
-#endif
-!!MVC*/
-
-ISC_STATUS   isc_attach_database (ISC_STATUS  *, 
-					    short, 
-					    char  *, 
-					    isc_db_handle  *, 
-					    short, 
-					    char  *);
-
-ISC_STATUS   isc_array_gen_sdl (ISC_STATUS  *, 
-					  ISC_ARRAY_DESC  *,
-					  short  *, 
-					  char  *, 
-					  short  *);
-
-ISC_STATUS   isc_array_get_slice (ISC_STATUS  *, 
-					    isc_db_handle  *, 
-					    isc_tr_handle  *, 
-					    ISC_QUAD  *, 
-					    ISC_ARRAY_DESC  *, 
-					    void  *, 
-					    ISC_LONG  *);
-
-ISC_STATUS   isc_array_lookup_bounds (ISC_STATUS  *, 
-						isc_db_handle  *, 
-						isc_tr_handle  *, 
-						char  *,
-						char  *, 
-						ISC_ARRAY_DESC  *);
-
-ISC_STATUS   isc_array_lookup_desc (ISC_STATUS  *, 
-					      isc_db_handle  *,
-					      isc_tr_handle  *, 
-					      char  *, 
-					      char  *, 
-					      ISC_ARRAY_DESC  *);
-
-ISC_STATUS   isc_array_set_desc (ISC_STATUS  *, 
-					   char  *, 
-					   char  *,
-					   short  *, 
-					   short  *, 
-					   short  *, 
-					   ISC_ARRAY_DESC  *);
-
-ISC_STATUS   isc_array_put_slice (ISC_STATUS  *, 
-					    isc_db_handle  *, 
-					    isc_tr_handle  *, 
-					    ISC_QUAD  *, 
-					    ISC_ARRAY_DESC  *, 
-					    void  *, 
-					    ISC_LONG  *);
-
-void        isc_blob_default_desc (ISC_BLOB_DESC  *,
-                                        unsigned char  *,
-                                        unsigned char  *);
-
-ISC_STATUS  isc_blob_gen_bpb (ISC_STATUS  *,
-					ISC_BLOB_DESC  *,
-					ISC_BLOB_DESC  *,
-					unsigned short,
-					unsigned char  *,
-					unsigned short  *);
-
-ISC_STATUS   isc_blob_info (ISC_STATUS  *, 
-				      isc_blob_handle  *, 
-				      short,
- 				      char  *, 
-				      short, 
-				      char  *);
-
-ISC_STATUS  isc_blob_lookup_desc (ISC_STATUS  *,
-					    isc_db_handle  *,
-					    isc_tr_handle  *,
-					    unsigned char  *,
-					    unsigned char  *,
-					    ISC_BLOB_DESC  *,
-					    unsigned char  *);
-
-ISC_STATUS  isc_blob_set_desc (ISC_STATUS  *,
-					 unsigned char  *,
-					 unsigned char  *,
-					 short,
-					 short,
-					 short,
-					 ISC_BLOB_DESC  *);
-
-ISC_STATUS   isc_cancel_blob (ISC_STATUS  *, 
-				        isc_blob_handle  *);
-
-ISC_STATUS   isc_cancel_events (ISC_STATUS  *, 
-					  isc_db_handle  *, 
-					  ISC_LONG  *);
-
-ISC_STATUS   isc_close_blob (ISC_STATUS  *, 
-				       isc_blob_handle  *);
-
-ISC_STATUS   isc_commit_retaining (ISC_STATUS  *, 
-					     isc_tr_handle  *);
-
-ISC_STATUS   isc_commit_transaction (ISC_STATUS  *, 
-					       isc_tr_handle  *);
-
-ISC_STATUS   isc_create_blob (ISC_STATUS  *, 
-					isc_db_handle  *, 
-					isc_tr_handle  *, 
-					isc_blob_handle  *, 
-					ISC_QUAD  *);
-
-ISC_STATUS   isc_create_blob2 (ISC_STATUS  *, 
-					 isc_db_handle  *, 
-					 isc_tr_handle  *, 
-					 isc_blob_handle  *, 
-					 ISC_QUAD  *, 
-					 short,  
-					 char  *); 
-
-ISC_STATUS   isc_create_database (ISC_STATUS  *, 
-					    short, 
-					    char  *, 
-					    isc_db_handle  *, 
-					    short, 
-					    char  *, 
-					    short);
-
-ISC_STATUS   isc_database_info (ISC_STATUS  *, 
-					  isc_db_handle  *, 
-					  short, 
-					  char  *, 
-					  short, 
-					  char  *);
-
-void         isc_decode_date (ISC_QUAD  *, 
-					void  *);
-
-void         isc_decode_sql_date (ISC_DATE  *, 
-					void  *);
-
-void         isc_decode_sql_time (ISC_TIME  *, 
-					void  *);
-
-void         isc_decode_timestamp (ISC_TIMESTAMP  *, 
-					void  *);
-
-ISC_STATUS   isc_detach_database (ISC_STATUS  *,  
-					    isc_db_handle  *);
-
-ISC_STATUS   isc_drop_database (ISC_STATUS  *,  
-					  isc_db_handle  *);
-
-ISC_STATUS   isc_dsql_allocate_statement (ISC_STATUS  *, 
-						    isc_db_handle  *, 
-						    isc_stmt_handle  *);
-
-ISC_STATUS   isc_dsql_alloc_statement2 (ISC_STATUS  *, 
-						  isc_db_handle  *, 
-						  isc_stmt_handle  *);
-
-ISC_STATUS   isc_dsql_describe (ISC_STATUS  *, 
-					  isc_stmt_handle  *, 
-					  unsigned short, 
-					  XSQLDA  *);
-
-ISC_STATUS   isc_dsql_describe_bind (ISC_STATUS  *, 
-					       isc_stmt_handle  *, 
-					       unsigned short, 
-					       XSQLDA  *);
-
-ISC_STATUS   isc_dsql_exec_immed2 (ISC_STATUS  *, 
-					     isc_db_handle  *, 
-					     isc_tr_handle  *, 
-					     unsigned short, 
-					     char  *, 
-					     unsigned short, 
-					     XSQLDA  *, 
-					     XSQLDA  *);
-
-ISC_STATUS   isc_dsql_execute (ISC_STATUS  *, 
-					 isc_tr_handle  *,
-					 isc_stmt_handle  *, 
-					 unsigned short, 
-					 XSQLDA  *);
-
-ISC_STATUS   isc_dsql_execute2 (ISC_STATUS  *, 
-					  isc_tr_handle  *,
-					  isc_stmt_handle  *, 
-					  unsigned short, 
-					  XSQLDA  *,
-					  XSQLDA  *);
-
-ISC_STATUS   isc_dsql_execute_immediate (ISC_STATUS  *, 
-						   isc_db_handle  *, 
-						   isc_tr_handle  *, 
-						   unsigned short, 
-						   char  *, 
-						   unsigned short, 
-						   XSQLDA  *);
-
-ISC_STATUS   isc_dsql_fetch (ISC_STATUS  *, 
-				       isc_stmt_handle  *, 
-				       unsigned short, 
-				       XSQLDA  *);
-
-ISC_STATUS   isc_dsql_finish (isc_db_handle  *);
-
-ISC_STATUS   isc_dsql_free_statement (ISC_STATUS  *, 
-						isc_stmt_handle  *, 
-						unsigned short);
-
-ISC_STATUS   isc_dsql_insert (ISC_STATUS  *, 
-				       isc_stmt_handle  *, 
-				       unsigned short, 
-				       XSQLDA  *);
-
-ISC_STATUS   isc_dsql_prepare (ISC_STATUS  *, 
-					 isc_tr_handle  *, 
-					 isc_stmt_handle  *, 
-					 unsigned short, 
-					 char  *, 
-					 unsigned short, 
-				 	 XSQLDA  *);
-
-ISC_STATUS   isc_dsql_set_cursor_name (ISC_STATUS  *, 
-						 isc_stmt_handle  *, 
-						 char  *, 
-						 unsigned short);
-
-ISC_STATUS   isc_dsql_sql_info (ISC_STATUS  *, 
-					  isc_stmt_handle  *, 
-					  short, 
-					  char  *, 
-					  short, 
-					  char  *);
-
-void         isc_encode_date (void  *, 
-					ISC_QUAD  *);
-
-void         isc_encode_sql_date (void  *, 
-					ISC_DATE  *);
-
-void         isc_encode_sql_time (void  *, 
-					ISC_TIME  *);
-
-void         isc_encode_timestamp (void  *, 
-					ISC_TIMESTAMP  *);
-
-ISC_LONG     isc_event_block (char  *  *, 
-					       char  *  *, 
-					       unsigned short, ...);
-
-/*!!MVC
-void         isc_event_counts (unsigned ISC_LONG  *, 
-					 short, 
-					 char  *,
-					 char  *);
-!!MVC*/
-
-void         isc_expand_dpb (char  *  *, 
-					      short  *, 
-					      ...);
-
-int         isc_modify_dpb (char  *  *, 
-					 short  *, unsigned short,
-					 char  *, short );
-
-ISC_LONG     isc_free (char  *);
-
-ISC_STATUS   isc_get_segment (ISC_STATUS  *, 
-				        isc_blob_handle  *, 
-				        unsigned short  *, 
-				        unsigned short, 
-				        char  *);
-
-ISC_STATUS   isc_get_slice (ISC_STATUS  *, 
-				      isc_db_handle  *, 
-				      isc_tr_handle  *, 
- 				      ISC_QUAD  *, 
- 				      short, 
-				      char  *, 
-				      short, 
-				      ISC_LONG  *, 
-				      ISC_LONG, 
-				      void  *, 
-				      ISC_LONG  *);
-
-ISC_STATUS   isc_interprete (char  *, 
-				       ISC_STATUS  *  *);
-
-ISC_STATUS   isc_open_blob (ISC_STATUS  *, 
-				      isc_db_handle  *, 
-				      isc_tr_handle  *, 
-				      isc_blob_handle  *, 
-				      ISC_QUAD  *);
-
-ISC_STATUS   isc_open_blob2 (ISC_STATUS  *, 
-				       isc_db_handle  *, 
-				       isc_tr_handle  *,
-				       isc_blob_handle  *, 
-				       ISC_QUAD  *, 
-				       short,  
-				       char  *);
-
-ISC_STATUS   isc_prepare_transaction2 (ISC_STATUS  *, 
-						 isc_tr_handle  *, 
-						 short, 
-						 char  *);
-
-void         isc_print_sqlerror (short, 
-					   ISC_STATUS  *);
-
-ISC_STATUS   isc_print_status (ISC_STATUS  *);
-
-ISC_STATUS   isc_put_segment (ISC_STATUS  *, 
-					isc_blob_handle  *, 
-					unsigned short, 
-					char  *);
-
-ISC_STATUS   isc_put_slice (ISC_STATUS  *, 
-				      isc_db_handle  *, 
-				      isc_tr_handle  *, 
-				      ISC_QUAD  *, 
-				      short, 
-				      char  *, 
-				      short, 
-				      ISC_LONG  *, 
-				      ISC_LONG, 
-				      void  *);
-
-ISC_STATUS   isc_que_events (ISC_STATUS  *, 
-				       isc_db_handle  *, 
-				       ISC_LONG  *, 
-				       short, 
-				       char  *, 
-				       isc_callback, 
-				       void  *);
-
-ISC_STATUS   isc_rollback_retaining (ISC_STATUS  *, 
-						 isc_tr_handle  *);
-
-ISC_STATUS   isc_rollback_transaction (ISC_STATUS  *, 
-						 isc_tr_handle  *);
-
-ISC_STATUS   isc_start_multiple (ISC_STATUS  *, 
-					   isc_tr_handle  *, 
-					   short, 
-					   void  *);
-
-ISC_STATUS   isc_start_transaction (ISC_STATUS  *, 
-						     isc_tr_handle  *,
-						     short, ...);
-
-ISC_LONG     isc_sqlcode (ISC_STATUS  *);
-
-void         isc_sql_interprete (short, 
-					   char  *, 
-					   short);
-
-ISC_STATUS   isc_transaction_info (ISC_STATUS  *,  
-					     isc_tr_handle  *, 
-					     short, 
-					     char  *, 
-					     short,  
-					     char  *);
-
-ISC_STATUS   isc_transact_request (ISC_STATUS  *,  
-					     isc_db_handle  *, 
-					     isc_tr_handle  *,
-					     unsigned short, 
-					     char  *, 
-					     unsigned short,  
-					     char  *,
-					     unsigned short,
-					     char  *);
-
-ISC_LONG     isc_vax_integer (char  *, 
-					short);
-
-ISC_INT64    isc_portable_integer  (unsigned char  *,
-                                              short);
-
-/*************************************/
-/* Security Functions and structures */
-/*************************************/
-
-#define sec_uid_spec		    0x01
-#define sec_gid_spec		    0x02
-#define sec_server_spec		    0x04
-#define sec_password_spec	    0x08
-#define sec_group_name_spec	    0x10
-#define sec_first_name_spec	    0x20
-#define sec_middle_name_spec        0x40
-#define sec_last_name_spec	    0x80
-#define sec_dba_user_name_spec      0x100
-#define sec_dba_password_spec       0x200
-
-#define sec_protocol_tcpip            1
-#define sec_protocol_netbeui          2
-#define sec_protocol_spx              3
-#define sec_protocol_local            4
-
-typedef struct {
-    short  sec_flags;		     /* which fields are specified */
-    int    uid;			     /* the user's id */
-    int	   gid;			     /* the user's group id */
-    int    protocol;		     /* protocol to use for connection */
-    char    *server;          /* server to administer */
-    char    *user_name;       /* the user's name */
-    char    *password;        /* the user's password */
-    char    *group_name;      /* the group name */
-    char    *first_name;	     /* the user's first name */
-    char    *middle_name;     /* the user's middle name */
-    char    *last_name;	     /* the user's last name */
-    char    *dba_user_name;   /* the dba user name */
-    char    *dba_password;    /* the dba password */
-} USER_SEC_DATA;
-
-int  isc_add_user (ISC_STATUS  *, USER_SEC_DATA *);
-
-int  isc_delete_user (ISC_STATUS  *, USER_SEC_DATA *);
-
-int  isc_modify_user (ISC_STATUS  *, USER_SEC_DATA *);
-
-/**********************************/
-/*  Other OSRI functions          */
-/**********************************/
-                                          
-ISC_STATUS   isc_compile_request (ISC_STATUS  *, 
-					    isc_db_handle  *,
-		  			    isc_req_handle  *, 
-					    short, 
-					    char  *);
-
-ISC_STATUS   isc_compile_request2 (ISC_STATUS  *, 
-					     isc_db_handle  *,
-					     isc_req_handle  *, 
-					     short, 
-					     char  *);
-
-ISC_STATUS   isc_ddl (ISC_STATUS  *,
-			        isc_db_handle  *, 
-			        isc_tr_handle  *,
-			        short, 
-			        char  *);
-
-ISC_STATUS   isc_prepare_transaction (ISC_STATUS  *, 
-						isc_tr_handle  *);
-
-
-ISC_STATUS   isc_receive (ISC_STATUS  *, 
-				    isc_req_handle  *, 
-				    short, 
-			 	    short, 
-				    void  *, 
-				    short);
-
-ISC_STATUS   isc_reconnect_transaction (ISC_STATUS  *,
-						  isc_db_handle  *, 
-						  isc_tr_handle  *, 
-						  short, 
-						  char  *);
-
-ISC_STATUS   isc_release_request (ISC_STATUS  *, 
-					    isc_req_handle  *);
-
-ISC_STATUS   isc_request_info (ISC_STATUS  *,  
-					 isc_req_handle  *, 
-					 short, 
-	  				 short, 
-					 char  *, 
-					 short, 
-					 char  *);	 
-
-ISC_STATUS   isc_seek_blob (ISC_STATUS  *, 
-				      isc_blob_handle  *, 
-				      short, 
-				      ISC_LONG, 
-				      ISC_LONG  *);
-
-ISC_STATUS   isc_send (ISC_STATUS  *, 
-				 isc_req_handle  *, 
-				 short, 
-				 short,
-				 void  *, 
-				 short);
-
-ISC_STATUS   isc_start_and_send (ISC_STATUS  *, 
-					   isc_req_handle  *, 
-					   isc_tr_handle  *, 
-					   short, 
-					   short, 
-					   void  *, 
-					   short);
-
-ISC_STATUS   isc_start_request (ISC_STATUS  *, 
-					  isc_req_handle  *,
-					  isc_tr_handle  *,
-					  short);
-
-ISC_STATUS   isc_unwind_request (ISC_STATUS  *, 
-					   isc_tr_handle  *,
-					   short);
-
-ISC_STATUS   isc_wait_for_event (ISC_STATUS  *, 
-					   isc_db_handle  *, 
-					   short, 
-					   char  *, 
-					   char  *);
-
-/*****************************/
-/* Other Sql functions       */
-/*****************************/
-
-ISC_STATUS   isc_close (ISC_STATUS  *, 
-				  char  *);
-
-ISC_STATUS   isc_declare (ISC_STATUS  *, 
-				    char  *, 
-				    char  *);
-
-ISC_STATUS   isc_describe (ISC_STATUS  *, 
-				    char  *, 
-				    XSQLDA  *);
-
-ISC_STATUS   isc_describe_bind (ISC_STATUS  *, 
-					  char  *, 
-					  XSQLDA  *);
-
-ISC_STATUS   isc_execute (ISC_STATUS  *, 
-				    isc_tr_handle  *, 
-				    char  *, 
-				    XSQLDA  *);
-
-ISC_STATUS   isc_execute_immediate (ISC_STATUS  *, 
-					      isc_db_handle  *,
-					      isc_tr_handle  *, 
-					      short  *, 
-					      char  *);
-
-ISC_STATUS   isc_fetch (ISC_STATUS  *, 
-				  char  *, 
-				  XSQLDA  *);
-
-ISC_STATUS   isc_open (ISC_STATUS  *, 
-				 isc_tr_handle  *, 
-				 char  *, 
-				 XSQLDA  *);
-
-ISC_STATUS   isc_prepare (ISC_STATUS  *, 
-				    isc_db_handle  *, 
-				    isc_tr_handle  *, 
-				    char  *, 
-				    short  *, 
-				    char  *, 
-				    XSQLDA  *);
-
-/*************************************/
-/* Other Dynamic sql functions       */
-/*************************************/
-
-ISC_STATUS   isc_dsql_execute_m (ISC_STATUS  *, 
-					   isc_tr_handle  *,
-					   isc_stmt_handle  *, 
-					   unsigned short, 
-					   char  *, 
-					   unsigned short, 
-					   unsigned short, 
-					   char  *);
-
-ISC_STATUS   isc_dsql_execute2_m (ISC_STATUS  *, 
-					   isc_tr_handle  *,
-					   isc_stmt_handle  *, 
-					   unsigned short, 
-					   char  *, 
-					   unsigned short, 
-					   unsigned short, 
-					   char  *,
-					   unsigned short, 
-					   char  *, 
-					   unsigned short, 
-					   unsigned short, 
-					   char  *);
-
-ISC_STATUS   isc_dsql_execute_immediate_m (ISC_STATUS  *, 
-						     isc_db_handle  *, 
-						     isc_tr_handle  *, 
-						     unsigned short, 
-						     char  *, 
-						     unsigned short, 
-						     unsigned short, 
-						     char  *,
-						     unsigned short,
-						     unsigned short,
-						     char  *);
-
-ISC_STATUS   isc_dsql_exec_immed3_m (ISC_STATUS  *, 
-					       isc_db_handle  *, 
-					       isc_tr_handle  *, 
-					       unsigned short, 
-					       char  *, 
-					       unsigned short, 
-					       unsigned short, 
-					       char  *,
-					       unsigned short,
-					       unsigned short,
-					       char  *,
-					       unsigned short, 
-					       char  *,
-					       unsigned short,
-					       unsigned short,
-					       char  *);
-
-ISC_STATUS   isc_dsql_fetch_m (ISC_STATUS  *, 
-					 isc_stmt_handle  *, 
-					 unsigned short, 
-					 char  *, 
-					 unsigned short, 
-					 unsigned short, 
-					 char  *);
-
-ISC_STATUS   isc_dsql_insert_m (ISC_STATUS  *, 
-					  isc_stmt_handle  *, 
-					  unsigned short, 
-					  char  *, 
-					  unsigned short, 
-					  unsigned short, 
-					  char  *);
-
-ISC_STATUS   isc_dsql_prepare_m (ISC_STATUS  *, 
-					   isc_tr_handle  *,
-				 	   isc_stmt_handle  *, 
-					   unsigned short,  
-					   char  *, 
-					   unsigned short,
-					   unsigned short, 
-				  	   char  *, 
-				 	   unsigned short,
-					   char  *);
-
-ISC_STATUS   isc_dsql_release (ISC_STATUS  *, 
-					 char  *);
-
-ISC_STATUS   isc_embed_dsql_close (ISC_STATUS  *, 
-					     char  *);
-
-ISC_STATUS   isc_embed_dsql_declare (ISC_STATUS  *, 
-					      char  *, 
-					      char  *);
-
-ISC_STATUS   isc_embed_dsql_describe (ISC_STATUS  *, 
-						char  *, 
-						unsigned short, 
-						XSQLDA  *);
-
-ISC_STATUS   isc_embed_dsql_describe_bind (ISC_STATUS  *, 
-						     char  *, 
-						     unsigned short, 
-						     XSQLDA  *);
-
-ISC_STATUS   isc_embed_dsql_execute (ISC_STATUS  *, 
-					       isc_tr_handle  *,
-					       char  *, 
-					       unsigned short, 
-					       XSQLDA  *);
-
-ISC_STATUS   isc_embed_dsql_execute2 (ISC_STATUS  *,
-						isc_tr_handle  *,
-						char  *,
-						unsigned short,
-						XSQLDA  *,
-						XSQLDA  *);
-
-ISC_STATUS   isc_embed_dsql_execute_immed (ISC_STATUS  *, 
-						     isc_db_handle  *, 
-						     isc_tr_handle  *, 
-						     unsigned short, 
-						     char  *, 	
-						     unsigned short, 
-						     XSQLDA  *);
-
-ISC_STATUS   isc_embed_dsql_fetch (ISC_STATUS  *, 
-					     char  *, 
-					     unsigned short, 
-					     XSQLDA  *);
-
-ISC_STATUS   isc_embed_dsql_open (ISC_STATUS  *, 
-					    isc_tr_handle  *, 
-					    char  *, 
-					    unsigned short, 
-					    XSQLDA  *);
-
-ISC_STATUS   isc_embed_dsql_open2 (ISC_STATUS  *, 
-					     isc_tr_handle  *, 
-					     char  *, 
-					     unsigned short, 
-					     XSQLDA  *,
-					     XSQLDA  *);
-
-ISC_STATUS   isc_embed_dsql_insert (ISC_STATUS  *, 
-					      char  *, 
-					      unsigned short, 
-					      XSQLDA  *);
-
-ISC_STATUS   isc_embed_dsql_prepare (ISC_STATUS  *, 
-					       isc_db_handle  *,
-					       isc_tr_handle  *, 
-					       char  *, 
-					       unsigned short, 
-					       char  *, 
-					       unsigned short, 
-					       XSQLDA  *);
-
-ISC_STATUS   isc_embed_dsql_release (ISC_STATUS  *, 
-					       char  *);
-
-/******************************/
-/* Other Blob functions       */
-/******************************/
-
-BSTREAM      *  BLOB_open (isc_blob_handle,  
-				        char  *,  
-				        int);
-
-int  	     BLOB_put (char, 
-				 BSTREAM  *);
-
-int  	     BLOB_close (BSTREAM  *);
-
-int  	     BLOB_get (BSTREAM  *);
-
-int          BLOB_display (ISC_QUAD  *, 
-				     isc_db_handle, 
-				     isc_tr_handle,
-				     char  *);
-
-int          BLOB_dump (ISC_QUAD  *, 
-				  isc_db_handle, 
-				  isc_tr_handle,
-				  char  *);
-
-int          BLOB_edit (ISC_QUAD  *, 
-				  isc_db_handle, 
-				  isc_tr_handle,
-				  char  *);
-
-int          BLOB_load (ISC_QUAD  *, 
-				  isc_db_handle, 
-				  isc_tr_handle,
-				  char  *);
-
-int          BLOB_text_dump (ISC_QUAD  *, 
-				  isc_db_handle, 
-				  isc_tr_handle,
-				  char  *);
-
-int          BLOB_text_load (ISC_QUAD  *, 
-				  isc_db_handle, 
-				  isc_tr_handle,
-				  char  *);
-
-BSTREAM      *  Bopen (ISC_QUAD  *, 
-			       	    isc_db_handle, 
-			       	    isc_tr_handle,  
-			       	    char  *);
-
-BSTREAM      *  Bopen2 (ISC_QUAD  *, 
-				     isc_db_handle,  
-				     isc_tr_handle,  
-				     char  *,
-				     unsigned short);
-
-/******************************/
-/* Other Misc functions       */
-/******************************/
-
-ISC_LONG     isc_ftof (char  *, 
-				 unsigned short, 
-				 char  *, 
-				 unsigned short);
-
-ISC_STATUS   isc_print_blr (char  *, 
-				      isc_callback, 
-				      void  *, 
-				      short);
-
-void         isc_set_debug (int);
-
-void         isc_qtoq (ISC_QUAD  *, 
-				 ISC_QUAD  *);
-
-void         isc_vtof (char  *, 
-				 char  *,
-				 unsigned short);
-
-void         isc_vtov (char  *, 
-				 char  *, 
-				 short);
-
-int          isc_version (isc_db_handle  *, 
-				    isc_callback, 
-				    void  *);
-
-ISC_LONG     isc_reset_fpe (unsigned short);
-
-/*****************************************/
-/* Service manager functions             */
-/*****************************************/
-
-/*!!MVC
-#define ADD_SPB_LENGTH(p, length)	{*(p)++ = (length); \
-    					 *(p)++ = (length) >> 8;}
-
-#define ADD_SPB_NUMERIC(p, data)	{*(p)++ = (data); \
-    					 *(p)++ = (data) >> 8; \
-					 *(p)++ = (data) >> 16; \
-					 *(p)++ = (data) >> 24;}
-!!MVC*/
-
-ISC_STATUS   isc_service_attach (ISC_STATUS  *, 
-					   unsigned short, 
-					   char  *,
-					   isc_svc_handle  *, 
-					   unsigned short, 
-					   char  *);
-
-ISC_STATUS   isc_service_detach (ISC_STATUS  *, 
-					   isc_svc_handle  *);
-
-ISC_STATUS   isc_service_query (ISC_STATUS  *, 
-					  isc_svc_handle  *,
-                      		          isc_resv_handle  *,
-					  unsigned short, 
-					  char  *, 
-					  unsigned short, 
-					  char  *, 
-					  unsigned short, 
-					  char  *);
-
-ISC_STATUS  isc_service_start (ISC_STATUS  *,
-    					 isc_svc_handle  *,
-                         		 isc_resv_handle  *,
-    					 unsigned short,
-    					 char *);
-
-/*******************************/
-/* Forms functions             */
-/*******************************/
-
-ISC_STATUS   isc_compile_map (ISC_STATUS  *, 
-					isc_form_handle  *,
-					isc_req_handle  *, 
-					short  *, 
-					char  *);
-
-ISC_STATUS   isc_compile_menu (ISC_STATUS  *, 
-					 isc_form_handle  *,
-					 isc_req_handle  *, 
-					 short  *, 
-				 	 char  *);
-
-ISC_STATUS   isc_compile_sub_map (ISC_STATUS  *, 
-					    isc_win_handle  *,
-					    isc_req_handle  *, 
-					    short  *, 
-					    char  *);
-
-ISC_STATUS   isc_create_window (ISC_STATUS  *, 
-					  isc_win_handle  *, 
-					  short  *, 
-					  char  *, 
-					  short  *, 
-					  short  *);
-
-ISC_STATUS   isc_delete_window (ISC_STATUS  *, 
-					  isc_win_handle  *);
-
-ISC_STATUS   isc_drive_form (ISC_STATUS  *, 
-				       isc_db_handle  *, 
-				       isc_tr_handle  *, 
-				       isc_win_handle  *, 
-				       isc_req_handle  *, 
-				       unsigned char  *, 
-				       unsigned char  *);
-
-ISC_STATUS   isc_drive_menu (ISC_STATUS  *, 
-				       isc_win_handle  *, 
-				       isc_req_handle  *, 
-				       short  *, 
-				       char  *, 
-				       short  *, 
-				       char  *,
-				       short  *, 
-				       short  *, 
-				       char  *, 
-				       ISC_LONG  *);
-
-ISC_STATUS   isc_form_delete (ISC_STATUS  *, 
-					isc_form_handle  *);
-
-ISC_STATUS   isc_form_fetch (ISC_STATUS  *, 
-				       isc_db_handle  *, 
-				       isc_tr_handle  *, 
-				       isc_req_handle  *, 
-				       unsigned char  *);
-
-ISC_STATUS   isc_form_insert (ISC_STATUS  *, 
-					isc_db_handle  *, 
-					isc_tr_handle  *, 
-					isc_req_handle  *, 
-					unsigned char  *);
-
-ISC_STATUS   isc_get_entree (ISC_STATUS  *, 
-				       isc_req_handle  *, 
-				       short  *, 
-				       char  *, 
-				       ISC_LONG  *, 
-				       short  *);
-
-ISC_STATUS   isc_initialize_menu (ISC_STATUS  *, 
-					    isc_req_handle  *);
-
-ISC_STATUS   isc_menu (ISC_STATUS  *, 
-				 isc_win_handle  *, 
-				 isc_req_handle  *, 
-			 	 short  *, 
-				 char  *);
-
-ISC_STATUS   isc_load_form (ISC_STATUS  *, 
-				      isc_db_handle  *, 
-				      isc_tr_handle  *, 
-				      isc_form_handle  *, 
-				      short  *, 
-				      char  *);
-																
-ISC_STATUS   isc_pop_window (ISC_STATUS  *, 
-				       isc_win_handle  *);
-
-ISC_STATUS   isc_put_entree (ISC_STATUS  *, 
-				       isc_req_handle  *, 
-				       short  *, 
-				       char  *, 
-				       ISC_LONG  *);
-
-ISC_STATUS   isc_reset_form (ISC_STATUS  *, 
-				       isc_req_handle  *);
-
-ISC_STATUS   isc_suspend_window (ISC_STATUS  *, 
-					   isc_win_handle  *);
-/*!!MVC
-#ifdef __cplusplus
-};
-#endif
-
-#else
-!!MVC */
- 
-ISC_STATUS   isc_attach_database();
-ISC_STATUS   isc_array_gen_sdl();
-ISC_STATUS   isc_array_get_slice();
-ISC_STATUS   isc_array_lookup_bounds();
-ISC_STATUS   isc_array_lookup_desc();
-ISC_STATUS   isc_array_set_desc();
-ISC_STATUS   isc_array_put_slice();
-ISC_STATUS   isc_blob_gen_bpb();
-ISC_STATUS   isc_blob_info();
-ISC_STATUS   isc_blob_lookup_desc();
-ISC_STATUS   isc_blob_set_desc();
-ISC_STATUS   isc_cancel_blob();
-ISC_STATUS   isc_cancel_events();
-ISC_STATUS   isc_close_blob();
-ISC_STATUS   isc_commit_retaining();
-ISC_STATUS   isc_commit_transaction();
-ISC_STATUS   isc_compile_request();
-ISC_STATUS   isc_compile_request2();
-ISC_STATUS   isc_create_blob();
-ISC_STATUS   isc_create_blob2();
-ISC_STATUS   isc_create_database();
-ISC_STATUS   isc_database_info();
-ISC_STATUS   isc_ddl();
-void         isc_decode_date();
-void         isc_decode_sql_date();
-void         isc_decode_sql_time();
-void         isc_decode_timestamp();
-ISC_STATUS   isc_detach_database();
-ISC_STATUS   isc_drop_database();
-void         isc_encode_date();
-void         isc_encode_sql_date();
-void         isc_encode_sql_time();
-void         isc_encode_timestamp();
-ISC_LONG     isc_event_block();
-void         isc_event_counts();
-void         isc_expand_dpb();
-int          isc_modify_dpb();
-ISC_LONG     isc_free();
-ISC_STATUS   isc_get_segment();
-ISC_STATUS   isc_get_slice();
-ISC_STATUS   isc_interprete();
-ISC_STATUS   isc_open_blob();
-ISC_STATUS   isc_open_blob2();
-ISC_STATUS   isc_prepare_transaction();
-ISC_STATUS   isc_prepare_transaction2();
-void         isc_print_sqlerror();
-ISC_STATUS   isc_print_status();
-ISC_STATUS   isc_put_segment();
-ISC_STATUS   isc_put_slice();
-ISC_STATUS   isc_que_events();
-ISC_STATUS   isc_receive();
-ISC_STATUS   isc_reconnect_transaction();
-ISC_STATUS   isc_release_request();
-ISC_STATUS   isc_request_info();
-ISC_LONG     isc_reset_fpe ();
-ISC_STATUS   isc_rollback_transaction();
-ISC_STATUS   isc_rollback_retaining();
-ISC_STATUS   isc_seek_blob();
-ISC_STATUS   isc_send();
-ISC_STATUS   isc_service_attach();
-ISC_STATUS   isc_service_detach();
-ISC_STATUS   isc_service_query();
-ISC_STATUS   isc_service_start();
-ISC_STATUS   isc_start_and_send();
-ISC_STATUS   isc_start_multiple();
-ISC_STATUS   isc_start_request();
-ISC_STATUS   isc_start_transaction();
-ISC_LONG     isc_sqlcode();
-ISC_STATUS   isc_transaction_info();
-ISC_STATUS   isc_transact_request();
-ISC_STATUS   isc_unwind_request();
-ISC_STATUS   isc_wait_for_event();
-ISC_LONG     isc_ftof();
-ISC_STATUS   isc_print_blr();
-void         isc_set_debug();
-void         isc_qtoq();
-ISC_LONG     isc_vax_integer();
-void         isc_vtof();
-void         isc_vtov();
-int          isc_version();
-
-#ifndef __STDC__
-
-/******************/
-/* Blob functions */
-/******************/
-
-BSTREAM    *  Bopen();
-BSTREAM    *  BLOB_open();
-BSTREAM    *  Bopen2();
-#endif					/* __STDC__ */
-
-#endif                                  /* __cplusplus || __STDC__ */
-
-/***************************************************/
-/* Actions to pass to the blob filter (ctl_source) */
-/***************************************************/
-
-#define isc_blob_filter_open             0
-#define isc_blob_filter_get_segment      1
-#define isc_blob_filter_close            2
-#define isc_blob_filter_create           3
-#define isc_blob_filter_put_segment      4
-#define isc_blob_filter_alloc            5
-#define isc_blob_filter_free             6
-#define isc_blob_filter_seek             7
-
-/*******************/
-/* Blr definitions */
-/*******************/
-
-#ifndef _JRD_BLR_H_
-
-/*!!MVC
-#define blr_word(n) ((n) % 256), ((n) / 256)
-!!MVC*/
-
-#define blr_text                           14
-#define blr_text2                          15
-#define blr_short                          7
-#define blr_long                           8
-#define blr_quad                           9
-#define blr_int64                          16
-#define blr_float                          10
-#define blr_double                         27
-#define blr_d_float                        11
-#define blr_timestamp                      35
-#define blr_varying                        37
-#define blr_varying2                       38
-#define blr_blob                           261
-#define blr_cstring                        40
-#define blr_cstring2                       41	
-#define blr_blob_id                        45
-#define blr_sql_date                       12
-#define blr_sql_time                       13
-
-/* Historical alias for pre V6 applications */
-#define blr_date                           blr_timestamp
-
-#define blr_inner                          0
-#define blr_left                           1
-#define blr_right                          2
-#define blr_full                           3
-
-#define blr_gds_code                       0
-#define blr_sql_code                       1
-#define blr_exception                      2
-#define blr_trigger_code                   3
-#define blr_default_code                   4
-
-#define blr_version4                       4
-#define blr_version5                       5
-#define blr_eoc                            76
-#define blr_end                            255
-
-#define blr_assignment                     1
-#define blr_begin                          2
-#define blr_dcl_variable                   3
-#define blr_message                        4
-#define blr_erase                          5
-#define blr_fetch                          6
-#define blr_for                            7
-#define blr_if                             8
-#define blr_loop                           9
-#define blr_modify                         10
-#define blr_handler                        11
-#define blr_receive                        12
-#define blr_select                         13
-#define blr_send                           14
-#define blr_store                          15
-#define blr_label                          17
-#define blr_leave                          18
-#define blr_store2                         19
-#define blr_post                           20
-
-#define blr_literal                        21
-#define blr_dbkey                          22
-#define blr_field                          23
-#define blr_fid                            24
-#define blr_parameter                      25
-#define blr_variable                       26
-#define blr_average                        27
-#define blr_count                          28
-#define blr_maximum                        29
-#define blr_minimum                        30
-#define blr_total                          31
-#define blr_add                            34
-#define blr_subtract                       35
-#define blr_multiply                       36
-#define blr_divide                         37
-#define blr_negate                         38
-#define blr_concatenate                    39
-#define blr_substring                      40
-#define blr_parameter2                     41
-#define blr_from                           42
-#define blr_via                            43
-#define blr_user_name                      44
-#define blr_null                           45
-
-#define blr_eql                            47
-#define blr_neq                            48
-#define blr_gtr                            49
-#define blr_geq                            50
-#define blr_lss                            51
-#define blr_leq                            52
-#define blr_containing                     53
-#define blr_matching                       54
-#define blr_starting                       55
-#define blr_between                        56
-#define blr_or                             57
-#define blr_and                            58
-#define blr_not                            59
-#define blr_any                            60
-#define blr_missing                        61
-#define blr_unique                         62
-#define blr_like                           63
-
-#define blr_stream                         65
-#define blr_set_index                      66
-#define blr_rse                            67
-#define blr_first                          68
-#define blr_project                        69
-#define blr_sort                           70
-#define blr_boolean                        71
-#define blr_ascending                      72
-#define blr_descending                     73
-#define blr_relation                       74
-#define blr_rid                            75
-#define blr_union                          76
-#define blr_map                            77
-#define blr_group_by                       78
-#define blr_aggregate                      79
-#define blr_join_type                      80
-
-#define blr_agg_count                      83
-#define blr_agg_max                        84
-#define blr_agg_min                        85
-#define blr_agg_total                      86
-#define blr_agg_average                    87
-#define blr_parameter3                     88
-#define	blr_run_count                      118
-#define	blr_run_max                        89
-#define	blr_run_min                        90
-#define	blr_run_total                      91
-#define	blr_run_average                    92
-#define blr_agg_count2                     93
-#define blr_agg_count_distinct             94
-#define blr_agg_total_distinct             95
-#define blr_agg_average_distinct           96
-
-#define blr_function                       100
-#define blr_gen_id                         101
-#define blr_prot_mask                      102
-#define blr_upcase                         103
-#define blr_lock_state                     104
-#define blr_value_if                       105
-#define blr_matching2                      106
-#define blr_index                          107
-#define blr_ansi_like                      108
-#define blr_bookmark                       109
-#define blr_crack                          110
-#define blr_force_crack                    111
-#define blr_seek                           112
-#define blr_find                           113
-
-#define blr_continue                       0
-#define blr_forward                        1
-#define blr_backward                       2
-#define blr_bof_forward                    3
-#define blr_eof_backward                   4
-
-#define blr_lock_relation                  114
-#define blr_lock_record                    115
-#define blr_set_bookmark		   116
-#define blr_get_bookmark		   117
-#define blr_rs_stream                      119
-#define blr_exec_proc                      120
-#define blr_begin_range                    121
-#define blr_end_range                      122
-#define blr_delete_range                   123
-#define blr_procedure                      124
-#define blr_pid                            125
-#define blr_exec_pid                       126
-#define blr_singular                       127
-#define blr_abort                          128
-#define blr_block                          129
-#define blr_error_handler                  130
-#define blr_cast                           131
-#define blr_release_lock                   132
-#define blr_release_locks                  133
-#define blr_start_savepoint                134
-#define blr_end_savepoint                  135
-#define blr_find_dbkey                     136
-#define blr_range_relation                 137
-#define blr_delete_ranges                  138
-
-#define blr_plan                           139
-#define blr_merge                          140
-#define blr_join                           141
-#define blr_sequential                     142
-#define blr_navigational                   143
-#define blr_indices                        144
-#define blr_retrieve                       145
-
-#define blr_relation2                      146
-#define blr_rid2                           147
-#define blr_reset_stream                   148
-#define blr_release_bookmark               149
-#define blr_set_generator                  150
-#define blr_ansi_any			   151   
-#define blr_exists			   152
-#define blr_cardinality			   153
-
-#define blr_record_version		   154		/* get tid of record */
-#define blr_stall			   155		/* fake server stall */
-#define blr_seek_no_warn		   156
-#define blr_find_dbkey_version		   157
-#define blr_ansi_all			   158   
-
-#define blr_extract                        159
-
-/* sub parameters for blr_extract */
-
-#define blr_extract_year                   0
-#define blr_extract_month                  1
-#define blr_extract_day	                   2
-#define blr_extract_hour                   3
-#define blr_extract_minute                 4
-#define blr_extract_second                 5
-#define blr_extract_weekday                6
-#define blr_extract_yearday                7
-
-#define blr_current_date                   160
-#define blr_current_timestamp              161
-#define blr_current_time                   162
-
-/* These verbs were added in 6.0, primarily to support 64-bit integers */
-
-#define blr_add2	          163
-#define blr_subtract2	          164
-#define blr_multiply2             165
-#define blr_divide2	          166
-#define blr_agg_total2            167
-#define blr_agg_total_distinct2   168
-#define blr_agg_average2          169
-#define blr_agg_average_distinct2 170
-#define blr_average2		  171
-#define blr_gen_id2		  172
-#define blr_set_generator2        173
-#endif					/* _JRD_BLR_H_ */
-
-/**********************************/
-/* Database parameter block stuff */
-/**********************************/
-
-#define isc_dpb_version1                  1
-#define isc_dpb_cdd_pathname              1
-#define isc_dpb_allocation                2
-#define isc_dpb_journal                   3
-#define isc_dpb_page_size                 4
-#define isc_dpb_num_buffers               5
-#define isc_dpb_buffer_length             6
-#define isc_dpb_debug                     7
-#define isc_dpb_garbage_collect           8
-#define isc_dpb_verify                    9
-#define isc_dpb_sweep                     10
-#define isc_dpb_enable_journal            11
-#define isc_dpb_disable_journal           12
-#define isc_dpb_dbkey_scope               13
-#define isc_dpb_number_of_users           14
-#define isc_dpb_trace                     15
-#define isc_dpb_no_garbage_collect        16
-#define isc_dpb_damaged                   17
-#define isc_dpb_license                   18
-#define isc_dpb_sys_user_name             19
-#define isc_dpb_encrypt_key               20
-#define isc_dpb_activate_shadow           21
-#define isc_dpb_sweep_interval            22
-#define isc_dpb_delete_shadow             23
-#define isc_dpb_force_write               24
-#define isc_dpb_begin_log                 25
-#define isc_dpb_quit_log                  26
-#define isc_dpb_no_reserve                27
-#define isc_dpb_user_name                 28
-#define isc_dpb_password                  29
-#define isc_dpb_password_enc              30
-#define isc_dpb_sys_user_name_enc         31
-#define isc_dpb_interp                    32
-#define isc_dpb_online_dump               33
-#define isc_dpb_old_file_size             34
-#define isc_dpb_old_num_files             35
-#define isc_dpb_old_file                  36
-#define isc_dpb_old_start_page            37
-#define isc_dpb_old_start_seqno           38
-#define isc_dpb_old_start_file            39
-#define isc_dpb_drop_walfile              40
-#define isc_dpb_old_dump_id               41
-#define isc_dpb_wal_backup_dir            42
-#define isc_dpb_wal_chkptlen              43
-#define isc_dpb_wal_numbufs               44
-#define isc_dpb_wal_bufsize               45
-#define isc_dpb_wal_grp_cmt_wait          46
-#define isc_dpb_lc_messages               47
-#define isc_dpb_lc_ctype                  48
-#define isc_dpb_cache_manager		  49
-#define isc_dpb_shutdown		  50
-#define isc_dpb_online			  51
-#define isc_dpb_shutdown_delay		  52
-#define isc_dpb_reserved		  53
-#define isc_dpb_overwrite		  54
-#define isc_dpb_sec_attach		  55
-#define isc_dpb_disable_wal		  56
-#define isc_dpb_connect_timeout           57
-#define isc_dpb_dummy_packet_interval     58
-#define isc_dpb_gbak_attach               59
-#define isc_dpb_sql_role_name             60
-#define isc_dpb_set_page_buffers          61
-#define isc_dpb_working_directory         62
-#define isc_dpb_SQL_dialect               63
-#define isc_dpb_set_db_readonly           64
-#define isc_dpb_set_db_SQL_dialect        65
-#define isc_dpb_gfix_attach		  66
-#define isc_dpb_gstat_attach		  67
-
-/*********************************/
-/* isc_dpb_verify specific flags */
-/*********************************/
-
-#define isc_dpb_pages                     1
-#define isc_dpb_records                   2
-#define isc_dpb_indices                   4
-#define isc_dpb_transactions              8
-#define isc_dpb_no_update                 16
-#define isc_dpb_repair                    32
-#define isc_dpb_ignore                    64
-
-/***********************************/
-/* isc_dpb_shutdown specific flags */
-/***********************************/
-
-#define isc_dpb_shut_cache               1
-#define isc_dpb_shut_attachment          2
-#define isc_dpb_shut_transaction         4
-#define isc_dpb_shut_force               8
-
-/**************************************/
-/* Bit assignments in RDB$SYSTEM_FLAG */
-/**************************************/
-
-#define RDB_system                         1
-#define RDB_id_assigned                    2
-
-/*************************************/
-/* Transaction parameter block stuff */
-/*************************************/
-
-#define isc_tpb_version1                  1
-#define isc_tpb_version3                  3
-#define isc_tpb_consistency               1
-#define isc_tpb_concurrency               2
-#define isc_tpb_shared                    3
-#define isc_tpb_protected                 4
-#define isc_tpb_exclusive                 5
-#define isc_tpb_wait                      6
-#define isc_tpb_nowait                    7
-#define isc_tpb_read                      8
-#define isc_tpb_write                     9
-#define isc_tpb_lock_read                 10
-#define isc_tpb_lock_write                11
-#define isc_tpb_verb_time                 12
-#define isc_tpb_commit_time               13
-#define isc_tpb_ignore_limbo              14
-#define isc_tpb_read_committed		  15
-#define isc_tpb_autocommit		  16
-#define isc_tpb_rec_version		  17
-#define isc_tpb_no_rec_version		  18
-#define isc_tpb_restart_requests	  19
-#define isc_tpb_no_auto_undo              20
-
-/************************/
-/* Blob Parameter Block */
-/************************/
-
-#define isc_bpb_version1                  1
-#define isc_bpb_source_type               1
-#define isc_bpb_target_type               2
-#define isc_bpb_type                      3
-#define isc_bpb_source_interp             4
-#define isc_bpb_target_interp             5
-#define isc_bpb_filter_parameter          6
-
-#define isc_bpb_type_segmented            0
-#define isc_bpb_type_stream               1
-
-/*********************************/
-/* Service parameter block stuff */
-/*********************************/
-
-#define isc_spb_version1                  1
-#define isc_spb_current_version           2
-#define isc_spb_version			  isc_spb_current_version
-#define isc_spb_user_name                 isc_dpb_user_name 
-#define isc_spb_sys_user_name             isc_dpb_sys_user_name
-#define isc_spb_sys_user_name_enc         isc_dpb_sys_user_name_enc
-#define isc_spb_password                  isc_dpb_password
-#define isc_spb_password_enc              isc_dpb_password_enc
-#define isc_spb_command_line              105
-#define isc_spb_dbname                    106
-#define isc_spb_verbose                   107
-#define isc_spb_options                   108
-
-#define isc_spb_connect_timeout           isc_dpb_connect_timeout
-#define isc_spb_dummy_packet_interval     isc_dpb_dummy_packet_interval
-#define isc_spb_sql_role_name             isc_dpb_sql_role_name
-
-/*********************************/
-/* Information call declarations */
-/*********************************/
-
-/****************************/
-/* Common, structural codes */
-/****************************/
-
-#define isc_info_end                      1
-#define isc_info_truncated                2
-#define isc_info_error                    3
-#define isc_info_data_not_ready	          4
-#define isc_info_flag_end		  127
-
-/******************************/
-/* Database information items */
-/******************************/
-
-#define isc_info_db_id                    4
-#define isc_info_reads                    5
-#define isc_info_writes                   6
-#define isc_info_fetches                  7
-#define isc_info_marks                    8
-#define isc_info_implementation           11
-#define isc_info_version                  12
-#define isc_info_base_level               13
-#define isc_info_page_size                14
-#define isc_info_num_buffers              15
-#define isc_info_limbo                    16
-#define isc_info_current_memory           17
-#define isc_info_max_memory               18
-#define isc_info_window_turns             19
-#define isc_info_license                  20
-#define isc_info_allocation               21
-#define isc_info_attachment_id            22
-#define isc_info_read_seq_count           23
-#define isc_info_read_idx_count           24
-#define isc_info_insert_count             25
-#define isc_info_update_count             26
-#define isc_info_delete_count             27
-#define isc_info_backout_count            28
-#define isc_info_purge_count              29
-#define isc_info_expunge_count            30
-#define isc_info_sweep_interval           31
-#define isc_info_ods_version              32
-#define isc_info_ods_minor_version        33
-#define isc_info_no_reserve               34
-#define isc_info_logfile                  35
-#define isc_info_cur_logfile_name         36
-#define isc_info_cur_log_part_offset      37
-#define isc_info_num_wal_buffers          38
-#define isc_info_wal_buffer_size          39
-#define isc_info_wal_ckpt_length          40
-#define isc_info_wal_cur_ckpt_interval    41
-#define isc_info_wal_prv_ckpt_fname       42
-#define isc_info_wal_prv_ckpt_poffset     43
-#define isc_info_wal_recv_ckpt_fname      44
-#define isc_info_wal_recv_ckpt_poffset    45
-#define isc_info_wal_grpc_wait_usecs      47
-#define isc_info_wal_num_io               48
-#define isc_info_wal_avg_io_size          49
-#define isc_info_wal_num_commits          50
-#define isc_info_wal_avg_grpc_size        51
-#define isc_info_forced_writes		  52
-#define isc_info_user_names		  53
-#define isc_info_page_errors		  54
-#define isc_info_record_errors		  55
-#define isc_info_bpage_errors		  56
-#define isc_info_dpage_errors	  	  57
-#define isc_info_ipage_errors	  	  58
-#define isc_info_ppage_errors		  59
-#define isc_info_tpage_errors	  	  60
-#define isc_info_set_page_buffers         61
-#define isc_info_db_SQL_dialect           62
-#define isc_info_db_read_only             63
-#define isc_info_db_size_in_pages	  64
-
-/**************************************/
-/* Database information return values */
-/**************************************/
-
-#define isc_info_db_impl_rdb_vms          1
-#define isc_info_db_impl_rdb_eln          2
-#define isc_info_db_impl_rdb_eln_dev      3
-#define isc_info_db_impl_rdb_vms_y        4
-#define isc_info_db_impl_rdb_eln_y        5
-#define isc_info_db_impl_jri              6
-#define isc_info_db_impl_jsv              7
-#define isc_info_db_impl_isc_a            25
-#define isc_info_db_impl_isc_u            26
-#define isc_info_db_impl_isc_v            27
-#define isc_info_db_impl_isc_s            28
-#define isc_info_db_impl_isc_apl_68K      25
-#define isc_info_db_impl_isc_vax_ultr     26
-#define isc_info_db_impl_isc_vms          27
-#define isc_info_db_impl_isc_sun_68k      28
-#define isc_info_db_impl_isc_os2          29
-#define isc_info_db_impl_isc_sun4         30
-#define isc_info_db_impl_isc_hp_ux        31
-#define isc_info_db_impl_isc_sun_386i     32
-#define isc_info_db_impl_isc_vms_orcl     33
-#define isc_info_db_impl_isc_mac_aux      34
-#define isc_info_db_impl_isc_rt_aix       35
-#define isc_info_db_impl_isc_mips_ult     36
-#define isc_info_db_impl_isc_xenix        37
-#define isc_info_db_impl_isc_dg           38
-#define isc_info_db_impl_isc_hp_mpexl     39
-#define isc_info_db_impl_isc_hp_ux68K     40
-#define isc_info_db_impl_isc_sgi          41
-#define isc_info_db_impl_isc_sco_unix     42
-#define isc_info_db_impl_isc_cray         43
-#define isc_info_db_impl_isc_imp          44
-#define isc_info_db_impl_isc_delta        45
-#define isc_info_db_impl_isc_next         46
-#define isc_info_db_impl_isc_dos          47
-#define isc_info_db_impl_isc_winnt        48
-#define isc_info_db_impl_isc_epson        49
-
-#define isc_info_db_class_access          1
-#define isc_info_db_class_y_valve         2
-#define isc_info_db_class_rem_int         3
-#define isc_info_db_class_rem_srvr        4
-#define isc_info_db_class_pipe_int        7
-#define isc_info_db_class_pipe_srvr       8
-#define isc_info_db_class_sam_int         9
-#define isc_info_db_class_sam_srvr        10
-#define isc_info_db_class_gateway         11
-#define isc_info_db_class_cache           12
-
-/*****************************/
-/* Request information items */
-/*****************************/
-
-#define isc_info_number_messages          4
-#define isc_info_max_message              5
-#define isc_info_max_send                 6
-#define isc_info_max_receive              7
-#define isc_info_state                    8
-#define isc_info_message_number           9
-#define isc_info_message_size             10
-#define isc_info_request_cost             11
-#define isc_info_access_path              12
-#define isc_info_req_select_count         13
-#define isc_info_req_insert_count         14
-#define isc_info_req_update_count         15
-#define isc_info_req_delete_count         16
-
-/*********************/
-/* Access path items */
-/*********************/
-
-#define isc_info_rsb_end		   0
-#define isc_info_rsb_begin		   1
-#define isc_info_rsb_type		   2
-#define isc_info_rsb_relation		   3
-#define isc_info_rsb_plan                  4
-
-/*************/
-/* Rsb types */
-/*************/
-
-#define isc_info_rsb_unknown		   1
-#define isc_info_rsb_indexed		   2
-#define isc_info_rsb_navigate		   3
-#define isc_info_rsb_sequential	 	   4
-#define isc_info_rsb_cross		   5
-#define isc_info_rsb_sort		   6
-#define isc_info_rsb_first		   7
-#define isc_info_rsb_boolean		   8
-#define isc_info_rsb_union		   9
-#define isc_info_rsb_aggregate		  10
-#define isc_info_rsb_merge		  11
-#define isc_info_rsb_ext_sequential	  12
-#define isc_info_rsb_ext_indexed	  13
-#define isc_info_rsb_ext_dbkey		  14
-#define isc_info_rsb_left_cross	 	  15
-#define isc_info_rsb_select		  16
-#define isc_info_rsb_sql_join		  17
-#define isc_info_rsb_simulate		  18
-#define isc_info_rsb_sim_cross		  19
-#define isc_info_rsb_once		  20
-#define isc_info_rsb_procedure		  21
-
-/**********************/
-/* Bitmap expressions */
-/**********************/
-
-#define isc_info_rsb_and		1
-#define isc_info_rsb_or			2
-#define isc_info_rsb_dbkey		3
-#define isc_info_rsb_index		4
-
-#define isc_info_req_active               2
-#define isc_info_req_inactive             3
-#define isc_info_req_send                 4
-#define isc_info_req_receive              5
-#define isc_info_req_select               6
-#define isc_info_req_sql_stall		  7
-
-/**************************/
-/* Blob information items */
-/**************************/
-
-#define isc_info_blob_num_segments        4
-#define isc_info_blob_max_segment         5
-#define isc_info_blob_total_length        6
-#define isc_info_blob_type                7
-
-/*********************************/
-/* Transaction information items */
-/*********************************/
-
-#define isc_info_tra_id                   4
-
-/*****************************
- * Service action items      *
- *****************************/
-
-#define isc_action_svc_backup          1 /* Starts database backup process on the server */ 
-#define isc_action_svc_restore         2 /* Starts database restore process on the server */ 
-#define isc_action_svc_repair          3 /* Starts database repair process on the server */ 
-#define isc_action_svc_add_user        4 /* Adds a new user to the security database */ 
-#define isc_action_svc_delete_user     5 /* Deletes a user record from the security database */ 
-#define isc_action_svc_modify_user     6 /* Modifies a user record in the security database */
-#define isc_action_svc_display_user    7 /* Displays a user record from the security database */
-#define isc_action_svc_properties      8 /* Sets database properties */ 
-#define isc_action_svc_add_license     9 /* Adds a license to the license file */ 
-#define isc_action_svc_remove_license 10 /* Removes a license from the license file */ 
-#define isc_action_svc_db_stats	      11 /* Retrieves database statistics */
-#define isc_action_svc_get_ib_log     12 /* Retrieves the InterBase log file from the server */
-
-/*****************************
- * Service information items *
- *****************************/
-
-#define isc_info_svc_svr_db_info      50 /* Retrieves the number of attachments and databases */ 
-#define isc_info_svc_get_license      51 /* Retrieves all license keys and IDs from the license file */
-#define isc_info_svc_get_license_mask 52 /* Retrieves a bitmask representing licensed options on the server */ 
-#define isc_info_svc_get_config       53 /* Retrieves the parameters and values for IB_CONFIG */ 
-#define isc_info_svc_version          54 /* Retrieves the version of the services manager */ 
-#define isc_info_svc_server_version   55 /* Retrieves the version of the InterBase server */ 
-#define isc_info_svc_implementation   56 /* Retrieves the implementation of the InterBase server */ 
-#define isc_info_svc_capabilities     57 /* Retrieves a bitmask representing the server's capabilities */ 
-#define isc_info_svc_user_dbpath      58 /* Retrieves the path to the security database in use by the server */ 
-#define isc_info_svc_get_env	      59 /* Retrieves the setting of $INTERBASE */
-#define isc_info_svc_get_env_lock     60 /* Retrieves the setting of $INTERBASE_LCK */
-#define isc_info_svc_get_env_msg      61 /* Retrieves the setting of $INTERBASE_MSG */
-#define isc_info_svc_line             62 /* Retrieves 1 line of service output per call */
-#define isc_info_svc_to_eof           63 /* Retrieves as much of the server output as will fit in the supplied buffer */
-#define isc_info_svc_timeout          64 /* Sets / signifies a timeout value for reading service information */
-#define isc_info_svc_get_licensed_users 65 /* Retrieves the number of users licensed for accessing the server */
-#define isc_info_svc_limbo_trans	66 /* Retrieve the limbo transactions */
-#define isc_info_svc_running		67 /* Checks to see if a service is running on an attachment */
-#define isc_info_svc_get_users		68 /* Returns the user information from isc_action_svc_display_users */
-
-/******************************************************
- * Parameters for isc_action_{add|delete|modify)_user *
- ******************************************************/
-
-#define isc_spb_sec_userid            5
-#define isc_spb_sec_groupid           6
-#define isc_spb_sec_username          7
-#define isc_spb_sec_password          8
-#define isc_spb_sec_groupname         9
-#define isc_spb_sec_firstname         10
-#define isc_spb_sec_middlename        11
-#define isc_spb_sec_lastname          12
-
-/*******************************************************
- * Parameters for isc_action_svc_(add|remove)_license, *
- * isc_info_svc_get_license                            *
- *******************************************************/
-
-#define isc_spb_lic_key               5
-#define isc_spb_lic_id                6
-#define isc_spb_lic_desc              7
-
-
-/*****************************************
- * Parameters for isc_action_svc_backup  *
- *****************************************/
-
-#define isc_spb_bkp_file                 5 
-#define isc_spb_bkp_factor               6
-#define isc_spb_bkp_length               7
-#define isc_spb_bkp_ignore_checksums     0x01
-#define isc_spb_bkp_ignore_limbo         0x02
-#define isc_spb_bkp_metadata_only        0x04
-#define isc_spb_bkp_no_garbage_collect   0x08
-#define isc_spb_bkp_old_descriptions     0x10
-#define isc_spb_bkp_non_transportable    0x20
-#define isc_spb_bkp_convert              0x40
-#define isc_spb_bkp_expand		 0x80
-
-/********************************************
- * Parameters for isc_action_svc_properties *
- ********************************************/
-
-#define isc_spb_prp_page_buffers		5
-#define isc_spb_prp_sweep_interval		6
-#define isc_spb_prp_shutdown_db			7
-#define isc_spb_prp_deny_new_attachments	9
-#define isc_spb_prp_deny_new_transactions	10
-#define isc_spb_prp_reserve_space		11
-#define isc_spb_prp_write_mode			12
-#define isc_spb_prp_access_mode			13
-#define isc_spb_prp_set_sql_dialect		14
-#define isc_spb_prp_activate			0x0100
-#define isc_spb_prp_db_online			0x0200
-
-/********************************************
- * Parameters for isc_spb_prp_reserve_space *
- ********************************************/
-
-#define isc_spb_prp_res_use_full	35
-#define isc_spb_prp_res			36
-
-/******************************************
- * Parameters for isc_spb_prp_write_mode  *
- ******************************************/
-
-#define isc_spb_prp_wm_async		37
-#define isc_spb_prp_wm_sync		38
-
-/******************************************
- * Parameters for isc_spb_prp_access_mode *
- ******************************************/
-
-#define isc_spb_prp_am_readonly		39
-#define isc_spb_prp_am_readwrite	40
-
-/*****************************************
- * Parameters for isc_action_svc_repair  *
- *****************************************/
-
-#define isc_spb_rpr_commit_trans		15
-#define isc_spb_rpr_rollback_trans		34
-#define isc_spb_rpr_recover_two_phase		17
-#define isc_spb_tra_id                     	18
-#define isc_spb_single_tra_id			19
-#define isc_spb_multi_tra_id			20
-#define isc_spb_tra_state			21
-#define isc_spb_tra_state_limbo			22
-#define isc_spb_tra_state_commit		23
-#define isc_spb_tra_state_rollback		24
-#define isc_spb_tra_state_unknown		25
-#define isc_spb_tra_host_site			26
-#define isc_spb_tra_remote_site			27
-#define isc_spb_tra_db_path			28
-#define isc_spb_tra_advise			29
-#define isc_spb_tra_advise_commit		30
-#define isc_spb_tra_advise_rollback		31
-#define isc_spb_tra_advise_unknown		33
-
-#define isc_spb_rpr_validate_db			0x01
-#define isc_spb_rpr_sweep_db			0x02
-#define isc_spb_rpr_mend_db			0x04
-#define isc_spb_rpr_list_limbo_trans		0x08
-#define isc_spb_rpr_check_db			0x10
-#define isc_spb_rpr_ignore_checksum		0x20
-#define isc_spb_rpr_kill_shadows		0x40
-#define isc_spb_rpr_full			0x80
-
-/*****************************************
- * Parameters for isc_action_svc_restore *
- *****************************************/
-
-#define isc_spb_res_buffers			9
-#define isc_spb_res_page_size			10 
-#define isc_spb_res_length			11
-#define isc_spb_res_access_mode			12
-#define isc_spb_res_deactivate_idx		0x0100
-#define isc_spb_res_no_shadow			0x0200
-#define isc_spb_res_no_validity			0x0400
-#define isc_spb_res_one_at_a_time		0x0800
-#define isc_spb_res_replace			0x1000
-#define isc_spb_res_create			0x2000
-#define isc_spb_res_use_all_space		0x4000
-
-/******************************************
- * Parameters for isc_spb_res_access_mode  *
- ******************************************/
-
-#define isc_spb_res_am_readonly			isc_spb_prp_am_readonly
-#define isc_spb_res_am_readwrite		isc_spb_prp_am_readwrite
-
-/*******************************************
- * Parameters for isc_info_svc_svr_db_info *
- *******************************************/
-
-#define isc_spb_num_att               5 
-#define isc_spb_num_db                6
-
-/*****************************************
- * Parameters for isc_info_svc_db_stats  *
- *****************************************/
-
-#define isc_spb_sts_data_pages		0x01
-#define isc_spb_sts_db_log		0x02
-#define isc_spb_sts_hdr_pages		0x04
-#define isc_spb_sts_idx_pages		0x08
-#define isc_spb_sts_sys_relations	0x10
-
-/*************************/
-/* SQL information items */
-/*************************/
-
-#define isc_info_sql_select               4
-#define isc_info_sql_bind                 5
-#define isc_info_sql_num_variables        6
-#define isc_info_sql_describe_vars        7
-#define isc_info_sql_describe_end         8
-#define isc_info_sql_sqlda_seq            9
-#define isc_info_sql_message_seq          10
-#define isc_info_sql_type                 11
-#define isc_info_sql_sub_type             12
-#define isc_info_sql_scale                13
-#define isc_info_sql_length               14
-#define isc_info_sql_null_ind             15
-#define isc_info_sql_field                16
-#define isc_info_sql_relation             17
-#define isc_info_sql_owner                18
-#define isc_info_sql_alias                19
-#define isc_info_sql_sqlda_start          20
-#define isc_info_sql_stmt_type            21
-#define isc_info_sql_get_plan             22
-#define isc_info_sql_records		  23
-#define isc_info_sql_batch_fetch	  24
-
-/*********************************/
-/* SQL information return values */
-/*********************************/
-
-#define isc_info_sql_stmt_select          1
-#define isc_info_sql_stmt_insert          2
-#define isc_info_sql_stmt_update          3
-#define isc_info_sql_stmt_delete          4
-#define isc_info_sql_stmt_ddl             5
-#define isc_info_sql_stmt_get_segment     6
-#define isc_info_sql_stmt_put_segment     7
-#define isc_info_sql_stmt_exec_procedure  8
-#define isc_info_sql_stmt_start_trans     9
-#define isc_info_sql_stmt_commit          10
-#define isc_info_sql_stmt_rollback        11
-#define isc_info_sql_stmt_select_for_upd  12
-#define isc_info_sql_stmt_set_generator   13
-
-/***********************************/
-/* Server configuration key values */
-/***********************************/
-
-#define	ISCCFG_LOCKMEM_KEY	0
-#define ISCCFG_LOCKSEM_KEY	1
-#define ISCCFG_LOCKSIG_KEY	2
-#define ISCCFG_EVNTMEM_KEY	3
-#define ISCCFG_DBCACHE_KEY	4
-#define ISCCFG_PRIORITY_KEY	5
-#define ISCCFG_IPCMAP_KEY	6
-#define ISCCFG_MEMMIN_KEY	7
-#define ISCCFG_MEMMAX_KEY	8
-#define	ISCCFG_LOCKORDER_KEY	9
-#define	ISCCFG_ANYLOCKMEM_KEY	10
-#define ISCCFG_ANYLOCKSEM_KEY	11
-#define ISCCFG_ANYLOCKSIG_KEY	12
-#define ISCCFG_ANYEVNTMEM_KEY	13
-#define ISCCFG_LOCKHASH_KEY	14
-#define ISCCFG_DEADLOCK_KEY	15
-#define ISCCFG_LOCKSPIN_KEY	16
-#define ISCCFG_CONN_TIMEOUT_KEY 17
-#define ISCCFG_DUMMY_INTRVL_KEY 18
-#define ISCCFG_TRACE_POOLS_KEY  19   /* Internal Use only */
-#define ISCCFG_REMOTE_BUFFER_KEY	20
-
-/***************/
-/* Error codes */
-/***************/
-
-#define isc_facility                       20
-#define isc_err_base                       335544320L
-#define isc_err_factor                     1
-#define isc_arg_end                        0
-#define isc_arg_gds                        1
-#define isc_arg_string                     2
-#define isc_arg_cstring                    3
-#define isc_arg_number                     4
-#define isc_arg_interpreted                5
-#define isc_arg_vms                        6
-#define isc_arg_unix                       7
-#define isc_arg_domain                     8
-#define isc_arg_dos                        9
-#define isc_arg_mpexl                      10
-#define isc_arg_mpexl_ipc                  11
-#define isc_arg_next_mach		   15
-#define isc_arg_netware		           16
-#define isc_arg_win32                      17
-#define isc_arg_warning                    18
-
-#include <iberror.h>
-
-/**********************************************/
-/* Dynamic Data Definition Language operators */
-/**********************************************/
-
-/******************/
-/* Version number */
-/******************/
-
-#define isc_dyn_version_1                 1
-#define isc_dyn_eoc                       255
-
-/******************************/
-/* Operations (may be nested) */
-/******************************/
-
-#define isc_dyn_begin                     2
-#define isc_dyn_end                       3
-#define isc_dyn_if                        4
-#define isc_dyn_def_database              5
-#define isc_dyn_def_global_fld            6
-#define isc_dyn_def_local_fld             7
-#define isc_dyn_def_idx                   8
-#define isc_dyn_def_rel                   9
-#define isc_dyn_def_sql_fld               10
-#define isc_dyn_def_view                  12
-#define isc_dyn_def_trigger               15
-#define isc_dyn_def_security_class        120
-#define isc_dyn_def_dimension             140
-#define isc_dyn_def_generator             24
-#define isc_dyn_def_function              25
-#define isc_dyn_def_filter                26
-#define isc_dyn_def_function_arg          27
-#define isc_dyn_def_shadow                34
-#define isc_dyn_def_trigger_msg           17
-#define isc_dyn_def_file                  36
-#define isc_dyn_mod_database              39
-#define isc_dyn_mod_rel                   11
-#define isc_dyn_mod_global_fld            13
-#define isc_dyn_mod_idx                   102
-#define isc_dyn_mod_local_fld             14
-#define isc_dyn_mod_sql_fld		  216
-#define isc_dyn_mod_view                  16
-#define isc_dyn_mod_security_class        122
-#define isc_dyn_mod_trigger               113
-#define isc_dyn_mod_trigger_msg           28
-#define isc_dyn_delete_database           18
-#define isc_dyn_delete_rel                19
-#define isc_dyn_delete_global_fld         20
-#define isc_dyn_delete_local_fld          21
-#define isc_dyn_delete_idx                22
-#define isc_dyn_delete_security_class     123
-#define isc_dyn_delete_dimensions         143
-#define isc_dyn_delete_trigger            23
-#define isc_dyn_delete_trigger_msg        29
-#define isc_dyn_delete_filter             32
-#define isc_dyn_delete_function           33
-#define isc_dyn_delete_shadow             35
-#define isc_dyn_grant                     30
-#define isc_dyn_revoke                    31
-#define isc_dyn_def_primary_key           37
-#define isc_dyn_def_foreign_key           38
-#define isc_dyn_def_unique                40
-#define isc_dyn_def_procedure             164
-#define isc_dyn_delete_procedure          165
-#define isc_dyn_def_parameter             135
-#define isc_dyn_delete_parameter          136
-#define isc_dyn_mod_procedure             175
-#define isc_dyn_def_log_file              176
-#define isc_dyn_def_cache_file            180
-#define isc_dyn_def_exception             181
-#define isc_dyn_mod_exception             182
-#define isc_dyn_del_exception             183
-#define isc_dyn_drop_log                  194
-#define isc_dyn_drop_cache                195
-#define isc_dyn_def_default_log           202
-
-/***********************/
-/* View specific stuff */
-/***********************/
-
-#define isc_dyn_view_blr                  43
-#define isc_dyn_view_source               44
-#define isc_dyn_view_relation             45
-#define isc_dyn_view_context              46
-#define isc_dyn_view_context_name         47
-
-/**********************/
-/* Generic attributes */
-/**********************/
-
-#define isc_dyn_rel_name                  50
-#define isc_dyn_fld_name                  51
-#define isc_dyn_new_fld_name		  215
-#define isc_dyn_idx_name                  52
-#define isc_dyn_description               53
-#define isc_dyn_security_class            54
-#define isc_dyn_system_flag               55
-#define isc_dyn_update_flag               56
-#define isc_dyn_prc_name                  166
-#define isc_dyn_prm_name                  137
-#define isc_dyn_sql_object                196
-#define isc_dyn_fld_character_set_name    174
-
-/********************************/
-/* Relation specific attributes */
-/********************************/
-
-#define isc_dyn_rel_dbkey_length          61
-#define isc_dyn_rel_store_trig            62
-#define isc_dyn_rel_modify_trig           63
-#define isc_dyn_rel_erase_trig            64
-#define isc_dyn_rel_store_trig_source     65
-#define isc_dyn_rel_modify_trig_source    66
-#define isc_dyn_rel_erase_trig_source     67
-#define isc_dyn_rel_ext_file              68
-#define isc_dyn_rel_sql_protection        69
-#define isc_dyn_rel_constraint            162
-#define isc_dyn_delete_rel_constraint     163
-
-/************************************/
-/* Global field specific attributes */
-/************************************/
-
-#define isc_dyn_fld_type                  70
-#define isc_dyn_fld_length                71
-#define isc_dyn_fld_scale                 72
-#define isc_dyn_fld_sub_type              73
-#define isc_dyn_fld_segment_length        74
-#define isc_dyn_fld_query_header          75
-#define isc_dyn_fld_edit_string           76
-#define isc_dyn_fld_validation_blr        77
-#define isc_dyn_fld_validation_source     78
-#define isc_dyn_fld_computed_blr          79
-#define isc_dyn_fld_computed_source       80
-#define isc_dyn_fld_missing_value         81
-#define isc_dyn_fld_default_value         82
-#define isc_dyn_fld_query_name            83
-#define isc_dyn_fld_dimensions            84
-#define isc_dyn_fld_not_null              85
-#define isc_dyn_fld_precision             86
-#define isc_dyn_fld_char_length           172
-#define isc_dyn_fld_collation             173
-#define isc_dyn_fld_default_source        193
-#define isc_dyn_del_default               197
-#define isc_dyn_del_validation            198
-#define isc_dyn_single_validation         199
-#define isc_dyn_fld_character_set         203
-
-/***********************************/
-/* Local field specific attributes */
-/***********************************/
-
-#define isc_dyn_fld_source                90
-#define isc_dyn_fld_base_fld              91
-#define isc_dyn_fld_position              92
-#define isc_dyn_fld_update_flag           93
-
-/*****************************/
-/* Index specific attributes */
-/*****************************/
-
-#define isc_dyn_idx_unique                100
-#define isc_dyn_idx_inactive              101
-#define isc_dyn_idx_type                  103
-#define isc_dyn_idx_foreign_key           104
-#define isc_dyn_idx_ref_column            105
-#define isc_dyn_idx_statistic		  204
-
-/*******************************/
-/* Trigger specific attributes */
-/*******************************/
-
-#define isc_dyn_trg_type                  110
-#define isc_dyn_trg_blr                   111
-#define isc_dyn_trg_source                112
-#define isc_dyn_trg_name                  114
-#define isc_dyn_trg_sequence              115
-#define isc_dyn_trg_inactive              116
-#define isc_dyn_trg_msg_number            117
-#define isc_dyn_trg_msg                   118
-
-/**************************************/
-/* Security Class specific attributes */
-/**************************************/
-
-#define isc_dyn_scl_acl                   121
-#define isc_dyn_grant_user                130
-#define isc_dyn_grant_proc                186
-#define isc_dyn_grant_trig                187
-#define isc_dyn_grant_view                188
-#define isc_dyn_grant_options             132
-#define isc_dyn_grant_user_group          205
-
-
-/**********************************/
-/* Dimension specific information */
-/**********************************/
-
-#define isc_dyn_dim_lower                 141
-#define isc_dyn_dim_upper                 142
-
-/****************************/
-/* File specific attributes */
-/****************************/
-
-#define isc_dyn_file_name                 125
-#define isc_dyn_file_start                126
-#define isc_dyn_file_length               127
-#define isc_dyn_shadow_number             128
-#define isc_dyn_shadow_man_auto           129
-#define isc_dyn_shadow_conditional        130
-
-/********************************/
-/* Log file specific attributes */
-/********************************/
-
-#define isc_dyn_log_file_sequence         177
-#define isc_dyn_log_file_partitions       178
-#define isc_dyn_log_file_serial           179
-#define isc_dyn_log_file_overflow         200
-#define isc_dyn_log_file_raw		  201
-
-/***************************/
-/* Log specific attributes */
-/***************************/
-
-#define isc_dyn_log_group_commit_wait     189 
-#define isc_dyn_log_buffer_size           190
-#define isc_dyn_log_check_point_length    191
-#define isc_dyn_log_num_of_buffers        192
-
-/********************************/
-/* Function specific attributes */
-/********************************/
-
-#define isc_dyn_function_name             145
-#define isc_dyn_function_type             146
-#define isc_dyn_func_module_name          147
-#define isc_dyn_func_entry_point          148
-#define isc_dyn_func_return_argument      149
-#define isc_dyn_func_arg_position         150
-#define isc_dyn_func_mechanism            151
-#define isc_dyn_filter_in_subtype         152
-#define isc_dyn_filter_out_subtype        153
-
-
-#define isc_dyn_description2		  154	
-#define isc_dyn_fld_computed_source2	  155	
-#define isc_dyn_fld_edit_string2	  156
-#define isc_dyn_fld_query_header2	  157
-#define isc_dyn_fld_validation_source2	  158
-#define isc_dyn_trg_msg2		  159
-#define isc_dyn_trg_source2		  160
-#define isc_dyn_view_source2		  161
-#define isc_dyn_xcp_msg2		  184
-
-/*********************************/
-/* Generator specific attributes */
-/*********************************/
-
-#define isc_dyn_generator_name            95
-#define isc_dyn_generator_id              96
-
-/*********************************/
-/* Procedure specific attributes */
-/*********************************/
-
-#define isc_dyn_prc_inputs                167
-#define isc_dyn_prc_outputs               168
-#define isc_dyn_prc_source                169
-#define isc_dyn_prc_blr                   170
-#define isc_dyn_prc_source2               171
-
-/*********************************/
-/* Parameter specific attributes */
-/*********************************/
-
-#define isc_dyn_prm_number                138
-#define isc_dyn_prm_type                  139
-
-/********************************/
-/* Relation specific attributes */
-/********************************/
-
-#define isc_dyn_xcp_msg                   185
-
-/**********************************************/
-/* Cascading referential integrity values     */
-/**********************************************/
-#define isc_dyn_foreign_key_update        205
-#define isc_dyn_foreign_key_delete        206
-#define isc_dyn_foreign_key_cascade       207
-#define isc_dyn_foreign_key_default       208
-#define isc_dyn_foreign_key_null          209
-#define isc_dyn_foreign_key_none          210
-
-/***********************/
-/* SQL role values     */
-/***********************/
-#define isc_dyn_def_sql_role              211
-#define isc_dyn_sql_role_name             212
-#define isc_dyn_grant_admin_options       213
-#define isc_dyn_del_sql_role              214
-
-/****************************/
-/* Last $dyn value assigned */
-/****************************/
-
-#define isc_dyn_last_dyn_value            216
-
-/******************************************/
-/* Array slice description language (SDL) */
-/******************************************/
-
-#define isc_sdl_version1                  1
-#define isc_sdl_eoc                       255
-#define isc_sdl_relation                  2
-#define isc_sdl_rid                       3
-#define isc_sdl_field                     4
-#define isc_sdl_fid                       5
-#define isc_sdl_struct                    6
-#define isc_sdl_variable                  7
-#define isc_sdl_scalar                    8
-#define isc_sdl_tiny_integer              9
-#define isc_sdl_short_integer             10
-#define isc_sdl_long_integer              11
-#define isc_sdl_literal                   12
-#define isc_sdl_add                       13
-#define isc_sdl_subtract                  14
-#define isc_sdl_multiply                  15
-#define isc_sdl_divide                    16
-#define isc_sdl_negate                    17
-#define isc_sdl_eql                       18
-#define isc_sdl_neq                       19
-#define isc_sdl_gtr                       20
-#define isc_sdl_geq                       21
-#define isc_sdl_lss                       22
-#define isc_sdl_leq                       23
-#define isc_sdl_and                       24
-#define isc_sdl_or                        25
-#define isc_sdl_not                       26
-#define isc_sdl_while                     27
-#define isc_sdl_assignment                28
-#define isc_sdl_label                     29
-#define isc_sdl_leave                     30
-#define isc_sdl_begin                     31
-#define isc_sdl_end                       32
-#define isc_sdl_do3                       33
-#define isc_sdl_do2                       34
-#define isc_sdl_do1                       35
-#define isc_sdl_element                   36
-
-/********************************************/
-/* International text interpretation values */
-/********************************************/
-
-#define isc_interp_eng_ascii              0
-#define isc_interp_jpn_sjis               5
-#define isc_interp_jpn_euc                6
-
-/*******************/
-/* SQL definitions */
-/*******************/
-
-#define SQL_TEXT                           452
-#define SQL_VARYING                        448
-#define SQL_SHORT                          500
-#define SQL_LONG                           496
-#define SQL_FLOAT                          482
-#define SQL_DOUBLE                         480
-#define SQL_D_FLOAT                        530
-#define SQL_TIMESTAMP                      510
-#define SQL_BLOB                           520
-#define SQL_ARRAY                          540
-#define SQL_QUAD                           550
-#define SQL_TYPE_TIME			   560
-#define SQL_TYPE_DATE                      570
-#define SQL_INT64			   580
-
-/* Historical alias for pre V6 applications */
-#define SQL_DATE			SQL_TIMESTAMP
-
-/*****************/
-/* Blob Subtypes */
-/*****************/
-
-/* types less than zero are reserved for customer use */
-
-#define isc_blob_untyped                   0
-
-/* internal subtypes */
-
-#define isc_blob_text                      1
-#define isc_blob_blr                       2
-#define isc_blob_acl                       3
-#define isc_blob_ranges                    4
-#define isc_blob_summary                   5
-#define isc_blob_format                    6
-#define isc_blob_tra                       7
-#define isc_blob_extfile                   8
-
-/* the range 20-30 is reserved for dBASE and Paradox types */
-
-#define isc_blob_formatted_memo            20
-#define isc_blob_paradox_ole               21
-#define isc_blob_graphic                   22
-#define isc_blob_dbase_ole                 23
-#define isc_blob_typed_binary              24
-
-#endif  				/* _JRD_IBASE_H_ */

packages/base/ibase/ibase60.inc

@@ -7,11 +7,13 @@
 interface
 
 {$IFDEF LinkDynamically}
-uses Dynlibs, sysutils;
+uses Dynlibs, sysutils,ctypes;
 
 Var
   UseEmbeddedFirebird : Boolean = False;
 
+{$ELSE}
+uses ctypes;
 {$ENDIF}
 
 {$IFDEF Unix}
@@ -66,7 +68,7 @@ type
 
 Type
    ISC_USHORT    = word;
-   ISC_STATUS    = longint;
+   ISC_STATUS    = clong;
    ISC_INT64     = int64;
    ISC_UINT64    = qword;
    ISC_LONG      = Longint;
@@ -1741,12 +1743,8 @@ type
 
   function isc_event_block(_para1:PPchar; _para2:PPchar; _para3:word; args:array of const):ISC_LONG; cdecl; external gdslib;
 
-  {!!MVC
-  void         isc_event_counts (unsigned ISC_LONG   ,
-                                         short,
-                                         char   ,
-                                         char   ); extdecl; external gdslib;
-  !!MVC }
+  procedure isc_event_counts(_para1: PISC_STATUS; _para2: short; _para3: pchar; _para4: pchar); extdecl;  external gdslib;
+
   procedure isc_expand_dpb(_para1:PPchar; _para2:Psmallint; args:array of const); cdecl; external gdslib;
 
   function isc_modify_dpb(_para1:PPchar; _para2:Psmallint; _para3:word; _para4:Pchar; _para5:smallint):longint; extdecl; external gdslib;
@@ -2278,12 +2276,7 @@ var
   isc_encode_sql_time : procedure (_para1:pointer; _para2:PISC_TIME); extdecl;
   isc_encode_timestamp : procedure (_para1:pointer; _para2:PISC_TIMESTAMP); extdecl;
   isc_event_block : function (_para1:PPchar; _para2:PPchar; _para3:word; args:array of const):ISC_LONG; cdecl;
-{!!MVC
-  void         isc_event_counts (unsigned ISC_LONG   ,
-  short,
-  char   ,
-  char   ); extdecl; external gdslib;
-!!MVC }
+  isc_event_counts: procedure (_para1: PISC_STATUS; _para2: short; _para3: pchar; _para4: pchar); extdecl;
   isc_expand_dpb : procedure (_para1:PPchar; _para2:Psmallint; args:array of const); cdecl;
   isc_modify_dpb : function (_para1:PPchar; _para2:Psmallint; _para3:word; _para4:Pchar; _para5:smallint):longint; extdecl;
   isc_free : function (_para1:Pchar):ISC_LONG; extdecl;
@@ -2437,8 +2430,9 @@ var
   isc_suspend_window : function (_para1:PISC_STATUS; _para2:Pisc_win_handle):ISC_STATUS; extdecl;
 {$ENDIF}
 
-Procedure InitialiseIBase60;
-Procedure ReleaseIBase60;
+function InitialiseIBase60(Const LibraryName : String) : integer;
+function InitialiseIBase60 : integer;
+procedure ReleaseIBase60;
 
 var IBaseLibraryHandle : TLibHandle;
 
@@ -2458,15 +2452,14 @@ var
   RefCount : integer;
   LoadedLibrary : String;
 
-Function TryInitialiseIBase60(Const LibraryName : String) : Boolean;
+Function TryInitialiseIBase60(Const LibraryName : String) : integer;
 
 begin
-  Result:=False;
+  Result := 0;
   if (RefCount=0) then
     begin
     IBaseLibraryHandle:=LoadLibrary(LibraryName);
-    Result:=(IBaseLibraryHandle<>nilhandle);
-    If not Result then
+    if (IBaseLibraryHandle=nilhandle) then
       Exit;
     inc(RefCount);
     LoadedLibrary:=LibraryName;
@@ -2517,6 +2510,7 @@ begin
     pointer(isc_encode_sql_time) := GetProcedureAddress(IBaseLibraryHandle,'isc_encode_sql_time');
     pointer(isc_encode_timestamp) := GetProcedureAddress(IBaseLibraryHandle,'isc_encode_timestamp');
     pointer(isc_event_block) := GetProcedureAddress(IBaseLibraryHandle,'isc_event_block');
+    pointer(isc_event_counts) := GetProcedureAddress(IBaseLibraryHandle,'isc_event_counts');
     pointer(isc_expand_dpb) := GetProcedureAddress(IBaseLibraryHandle,'isc_expand_dpb');
     pointer(isc_modify_dpb) := GetProcedureAddress(IBaseLibraryHandle,'isc_modify_dpb');
     pointer(isc_free) := GetProcedureAddress(IBaseLibraryHandle,'isc_free');
@@ -2638,35 +2632,40 @@ begin
 {$ENDIF}
     end
   else
-    begin
-    If (LoadedLibrary<>LibraryName) then
-      Raise EInoutError.CreateFmt(SErrAlreadyLoaded,[LoadedLibrary]);
     inc(RefCount);
-    Result:=True;
-    end;  
+  Result := RefCount;
 end;
 
-Procedure InitialiseIBase60;
+function InitialiseIBase60 : integer;
 
 begin
+  Result := 0;
   If UseEmbeddedFirebird then
     begin
-    If Not TryInitialiseIBase60(fbembedlib) then
+    If (TryInitialiseIBase60(fbembedlib)=0) then
       Raise EInOutError.CreateFmt(SErrEmbeddedFailed,[fbembedlib]);
     end
   else
     begin
-    If (Not TryInitialiseIBase60(fbclib)) and
-       (Not TryInitialiseIBase60(gdslib)) then
+    If (TryInitialiseIBase60(fbclib)=0) and
+       (TryInitialiseIBase60(gdslib)=0) then
         Raise EInOutError.CreateFmt(SErrDefaultsFailed,[gdslib,fbclib]);
     end;    
+  Result := RefCount;
 end;
 
-Procedure InitialiseIBase60(Const LibraryName : String);
+function InitialiseIBase60(Const LibraryName : String) : integer;
 
 begin
-  If Not TryInitialiseIbase60(LibraryName) then
-    Raise EInOutError.CreateFmt(SErrLoadFailed,[LibraryName]);
+  Result := TryInitialiseIBase60(LibraryName);
+  If Result = 0 then
+    Raise EInOutError.CreateFmt(SErrLoadFailed,[LibraryName])
+  else If (LibraryName<>LoadedLibrary) then
+    begin
+    Dec(RefCount);
+    Result := RefCount;
+    Raise EInOUtError.CreateFmt(SErrAlreadyLoaded,[LoadedLibrary]);
+    end;
 end;
 
 

packages/base/odbc/testodbc.pp

@@ -33,11 +33,11 @@ Var
 Procedure FreeHandles;
 
 begin
-  If StmtHAndle<>0 then
+  If assigned(StmtHAndle) then
     SQLFreeHandle(SQL_HANDLE_STMT,StmtHandle);
-  If DBHandle<>0 then
+  If assigned(dbhandle) then
     SQLFreeHandle(SQL_HANDLE_DBC,DBHandle);
-  If EnvHandle<>0 then
+  If assigned(EnvHandle) then
     SQLFreeHandle(SQL_HANDLE_ENV,EnvHandle);
 end;
 
@@ -55,9 +55,9 @@ Var
   Res : Integer;
 
 begin
-  EnvHandle:=0;
-  DBHandle:=0;
-  StmtHandle:=0;
+  EnvHandle:=nil;
+  DBHandle:=nil;
+  StmtHandle:=nil;
   Res:=SQLAllocHandle(SQL_HANDLE_ENV, SQL_NULL_HANDLE, EnvHandle);
   if Res <> SQL_SUCCESS then
     DoError('Could allocate ODBC handle',Res);

packages/base/sqlite/sqlite3.inc

@@ -25,7 +25,7 @@ uses
 {$PACKRECORDS C}
 
 const
-{$IFDEF MSWINDOWS}
+{$IFDEF WINDOWS}
   Sqlite3Lib = 'sqlite3.dll';
 {$else}
   Sqlite3Lib = 'libsqlite3.so';
@@ -505,7 +505,7 @@ begin
   pointer(sqlite3_collation_needed16) := GetProcedureAddress(LibHandle,'sqlite3_collation_needed16');
   pointer(sqlite3_libversion):=GetProcedureAddress(LibHandle,'sqlite3_libversion');
 //Alias for allowing better code portability (win32 is not working with external variables) 
-  pointer(sqlite3_version):=GetProcedureAddress(LibHandle,'sqlite3_version');
+  pointer(sqlite3_version):=GetProcedureAddress(LibHandle,'sqlite3_libversion');
 
 // Not published functions
   pointer(sqlite3_libversion_number):=GetProcedureAddress(LibHandle,'sqlite3_libversion_number');

packages/base/winunits/Makefile.fpc

@@ -8,7 +8,7 @@ version=2.2.1
 
 [target]
 units=buildjwa
-implicitunits=winver mmsystem comobj comconst commctrl ole2 activex shellapi shlobj oleserver \
+implicitunits=flatsb winver mmsystem comobj comconst commctrl ole2 activex shellapi shlobj oleserver \
  jwawintype jwawinbase jwawinnt \
  jwalmerr jwalmmsg jwaaclui jwaadsdb jwalmerrlog jwalmjoin jwaauthz  \
  jwabits jwalmremutl jwalmrepl jwalmserver jwalmshare jwalmsname \

packages/base/winunits/activex.pp

@@ -1558,6 +1558,22 @@ TYPE
       Function LockServer(fLock : Bool):HResult;StdCall;
       End;
 
+    PLicInfo = ^TLicInfo;
+    tagLICINFO = record
+      cbLicInfo : ULONG;
+      fRuntimeKeyAvail : BOOL;
+      fLicVerified : BOOL;
+    end;
+    TLicInfo = tagLICINFO;
+    LICINFO = TLicInfo;
+
+    IClassFactory2 = interface(IClassFactory)
+      ['{B196B28F-BAB4-101A-B69C-00AA00341D07}']
+      function GetLicInfo(var licInfo: TLicInfo): HResult; stdcall;
+      function RequestLicKey(dwResrved: DWORD; out bstrKey: WideString): HResult; stdcall;
+      function CreateInstanceLic(const unkOuter: IUnknown; const unkReserved: IUnknown;
+        const iid: TIID; const bstrKey: WideString; out vObject): HResult; stdcall;
+    end;
 
 // objidl.idl
 
@@ -1889,15 +1905,14 @@ TYPE
        Function GetData(Const formatetcIn : FORMATETC;Out medium : STGMEDIUM):HRESULT; STDCALL;
        Function GetDataHere(CONST pformatetc : FormatETC; Out medium : STGMEDIUM):HRESULT; STDCALL;
        Function QueryGetData(const pformatetc : FORMATETC):HRESULT; STDCALL;
-       Function GetCanonicalFormatTEtc(const pformatetcIn : FORMATETC;Out pformatetcOut : FORMATETC):HResult; STDCALl;
+       Function GetCanonicalFormatEtc(const pformatetcIn : FORMATETC;Out pformatetcOut : FORMATETC):HResult; STDCALl;
        Function SetData (Const pformatetc : FORMATETC;const medium:STGMEDIUM;FRelease : BOOL):HRESULT; StdCall;
        Function EnumFormatEtc(dwDirection : DWord; OUT enumformatetcpara : IENUMFORMATETC):HRESULT; StdCall;
        Function DAdvise(const formatetc : FORMATETC;advf :DWORD; CONST AdvSink : IAdviseSink;OUT dwConnection:DWORD):HRESULT;StdCall;
        Function DUnadvise(dwconnection :DWord) :HRESULT;StdCall;
-       Function EnumDAvise(Out enumAdvise : IEnumStatData):HResult;StdCall;
+       Function EnumDAdvise(Out enumAdvise : IEnumStatData):HResult;StdCall;
        End;
 
-
     IDataAdviseHolder = Interface (IUnknown)
        ['{00000110-0000-0000-C000-000000000046}']
        Function Advise    (CONST pdataObject : IDataObject;CONST fetc:FORMATETC;advf : DWORD;Const pAdvise:IAdviseSink;Out DwConnection:DWord):HResult; StdCall;

packages/base/winunits/buildjwa.pp

@@ -21,7 +21,7 @@ unit buildjwa;
 interface
 
 uses
-    winver, mmsystem, comconst, commctrl, comobj, ole2, activex, shellapi, shlobj, oleserver,
+    flatsb, winver, mmsystem, comconst, commctrl, comobj, ole2, activex, shellapi, shlobj, oleserver,
     jwawintype, jwawinbase, jwawinnt, shfolder, richedit,
     jwalmerr, jwalmmsg, jwaaclui, jwaadsdb, jwalmerrlog, jwalmjoin, jwaauthz,
     jwabits, jwalmremutl, jwalmrepl, jwalmserver, jwalmshare, jwalmsname,

packages/base/winunits/commctrl.pp

@@ -106,7 +106,7 @@ CONST CommCtrlDLL = 'comctl32.dll';
 
 // include <prsht.h>
 
-Procedure InitCommonControls; external commctrldll name 'InitCommonControls';
+Procedure InitCommonControls; stdcall; external commctrldll name 'InitCommonControls';
 
 {$ifdef ie3plus}
 TYPE
@@ -143,7 +143,7 @@ CONST
          ICC_LINK_CLASS                 = $00008000;
 {$ENDIF}
 
-function InitCommonControlsEx(var rec : TINITCOMMONCONTROLSEX):BOOL; external commctrldll name 'InitCommonControlsEx';
+function InitCommonControlsEx(var rec : TINITCOMMONCONTROLSEX):BOOL; stdcall; external commctrldll name 'InitCommonControlsEx';
 {$ENDIF}      // _WIN32_IE >= 0x0300
 
 CONST
@@ -560,20 +560,20 @@ CONST
          ILC_PERITEMMIRROR              = $00008000;          // Causes the mirroring code to mirror each item when inserting a set of images, verses the whole strip
 {$ENDIF}
 
-function ImageList_Create(cx:cint;cy:cint;flags:UINT;cInitial:cint;cGrow:cint):HIMAGELIST; external commctrldll name 'ImageList_Create';
-function ImageList_Destroy(himl:HIMAGELIST):BOOL; external commctrldll name 'ImageList_Destroy';
+function ImageList_Create(cx:cint;cy:cint;flags:UINT;cInitial:cint;cGrow:cint):HIMAGELIST; stdcall; external commctrldll name 'ImageList_Create';
+function ImageList_Destroy(himl:HIMAGELIST):BOOL; stdcall; external commctrldll name 'ImageList_Destroy';
 
-function ImageList_GetImageCount(himl:HIMAGELIST):cint; external commctrldll name 'ImageList_GetImageCount';
+function ImageList_GetImageCount(himl:HIMAGELIST):cint; stdcall; external commctrldll name 'ImageList_GetImageCount';
 {$ifdef ie3plus}
-function ImageList_SetImageCount(himl:HIMAGELIST;uNewCount:UINT):BOOL; external commctrldll name 'ImageList_SetImageCount';
+function ImageList_SetImageCount(himl:HIMAGELIST;uNewCount:UINT):BOOL; stdcall; external commctrldll name 'ImageList_SetImageCount';
 {$ENDIF}
 
-function ImageList_Add(himl:HIMAGELIST;hbmImage:HBITMAP;hbmMask:HBITMAP):cint; external commctrldll name 'ImageList_Add';
+function ImageList_Add(himl:HIMAGELIST;hbmImage:HBITMAP;hbmMask:HBITMAP):cint; stdcall; external commctrldll name 'ImageList_Add';
 
-function ImageList_ReplaceIcon(himl:HIMAGELIST;i:cint;hicon:HICON):cint; external commctrldll name 'ImageList_ReplaceIcon';
-function ImageList_SetBkColor(himl:HIMAGELIST;clrBk:COLORREF):COLORREF; external commctrldll name 'ImageList_SetBkColor';
-function ImageList_GetBkColor(himl:HIMAGELIST):COLORREF; external commctrldll name 'ImageList_GetBkColor';
-function ImageList_SetOverlayImage(himl:HIMAGELIST;iImage:cint;iOverlay:cint):BOOL; external commctrldll name 'ImageList_SetOverlayImage';
+function ImageList_ReplaceIcon(himl:HIMAGELIST;i:cint;hicon:HICON):cint; stdcall; external commctrldll name 'ImageList_ReplaceIcon';
+function ImageList_SetBkColor(himl:HIMAGELIST;clrBk:COLORREF):COLORREF; stdcall; external commctrldll name 'ImageList_SetBkColor';
+function ImageList_GetBkColor(himl:HIMAGELIST):COLORREF; stdcall; external commctrldll name 'ImageList_GetBkColor';
+function ImageList_SetOverlayImage(himl:HIMAGELIST;iImage:cint;iOverlay:cint):BOOL; stdcall; external commctrldll name 'ImageList_SetOverlayImage';
 
 // Macro 11
 Function ImageList_AddIcon(Himl:HIMAGELIST;hicon:HICON):cint;
@@ -609,24 +609,24 @@ CONST
          ILS_SATURATE                   = $00000004;
          ILS_ALPHA                      = $00000008;
 
-function ImageList_Draw(himl:HIMAGELIST;i:cint;hdcDst:HDC;x:cint;y:cint;fStyle:UINT):BOOL; external commctrldll name 'ImageList_Draw';
+function ImageList_Draw(himl:HIMAGELIST;i:cint;hdcDst:HDC;x:cint;y:cint;fStyle:UINT):BOOL; stdcall; external commctrldll name 'ImageList_Draw';
 
 
 {$IFDEF _WIN32}
 
-function ImageList_Replace(himl:HIMAGELIST;i:cint;hbmImage:HBITMAP;hbmMask:HBITMAP):BOOL; external commctrldll name 'ImageList_Replace';
+function ImageList_Replace(himl:HIMAGELIST;i:cint;hbmImage:HBITMAP;hbmMask:HBITMAP):BOOL; stdcall; external commctrldll name 'ImageList_Replace';
 
-function ImageList_AddMasked(himl:HIMAGELIST;hbmImage:HBITMAP;crMask:COLORREF):cint; external commctrldll name 'ImageList_AddMasked';
-function ImageList_DrawEx(himl:HIMAGELIST;i:cint;hdcDst:HDC;x:cint;y:cint;dx:cint;dy:cint;rgbBk:COLORREF;rgbFg:COLORREF;fStyle:UINT):BOOL; external commctrldll name 'ImageList_DrawEx';
+function ImageList_AddMasked(himl:HIMAGELIST;hbmImage:HBITMAP;crMask:COLORREF):cint; stdcall; external commctrldll name 'ImageList_AddMasked';
+function ImageList_DrawEx(himl:HIMAGELIST;i:cint;hdcDst:HDC;x:cint;y:cint;dx:cint;dy:cint;rgbBk:COLORREF;rgbFg:COLORREF;fStyle:UINT):BOOL; stdcall; external commctrldll name 'ImageList_DrawEx';
 {$ifdef ie3plus}
-function ImageList_DrawIndirect(pimldp:PIMAGELISTDRAWPARAMS):BOOL; external commctrldll name 'ImageList_DrawIndirect';
+function ImageList_DrawIndirect(pimldp:PIMAGELISTDRAWPARAMS):BOOL; stdcall; external commctrldll name 'ImageList_DrawIndirect';
 {$ENDIF}
-function ImageList_Remove(himl:HIMAGELIST;i:cint):BOOL; external commctrldll name 'ImageList_Remove';
-function ImageList_GetIcon(himl:HIMAGELIST;i:cint;flags:UINT):HICON; external commctrldll name 'ImageList_GetIcon';
-function ImageList_LoadImageA(hi:HINST;lpbmp:LPCSTR;cx:cint;cGrow:cint;crMask:COLORREF;uType:UINT;uFlags:UINT):HIMAGELIST; external commctrldll name 'ImageList_LoadImageA';
-function ImageList_LoadImageW(hi:HINST;lpbmp:LPCWSTR;cx:cint;cGrow:cint;crMask:COLORREF;uType:UINT;uFlags:UINT):HIMAGELIST; external commctrldll name 'ImageList_LoadImageW';
-function ImageList_LoadImage(hi:HINST;lpbmp:LPCSTR;cx:cint;cGrow:cint;crMask:COLORREF;uType:UINT;uFlags:UINT):HIMAGELIST; external commctrldll name 'ImageList_LoadImageA';
-function ImageList_LoadImage(hi:HINST;lpbmp:LPCWSTR;cx:cint;cGrow:cint;crMask:COLORREF;uType:UINT;uFlags:UINT):HIMAGELIST; external commctrldll name 'ImageList_LoadImageW';
+function ImageList_Remove(himl:HIMAGELIST;i:cint):BOOL; stdcall; external commctrldll name 'ImageList_Remove';
+function ImageList_GetIcon(himl:HIMAGELIST;i:cint;flags:UINT):HICON; stdcall; external commctrldll name 'ImageList_GetIcon';
+function ImageList_LoadImageA(hi:HINST;lpbmp:LPCSTR;cx:cint;cGrow:cint;crMask:COLORREF;uType:UINT;uFlags:UINT):HIMAGELIST; stdcall; external commctrldll name 'ImageList_LoadImageA';
+function ImageList_LoadImageW(hi:HINST;lpbmp:LPCWSTR;cx:cint;cGrow:cint;crMask:COLORREF;uType:UINT;uFlags:UINT):HIMAGELIST; stdcall; external commctrldll name 'ImageList_LoadImageW';
+function ImageList_LoadImage(hi:HINST;lpbmp:LPCSTR;cx:cint;cGrow:cint;crMask:COLORREF;uType:UINT;uFlags:UINT):HIMAGELIST; stdcall; external commctrldll name 'ImageList_LoadImageA';
+function ImageList_LoadImage(hi:HINST;lpbmp:LPCWSTR;cx:cint;cGrow:cint;crMask:COLORREF;uType:UINT;uFlags:UINT):HIMAGELIST; stdcall; external commctrldll name 'ImageList_LoadImageW';
 
 {$IFDEF UNICODE}
 // function ImageList_LoadImageW(hi:HINSTANCE;lpbmp:LPCWSTR;cx:cint;cGrow:cint;crMask:COLORREF;uType:UINT;uFlags:UINT):HIMAGELIST; external commctrldll name 'ImageList_LoadImageW';
@@ -640,18 +640,18 @@ CONST
          ILCF_MOVE                      = ($00000000);
          ILCF_SWAP                      = ($00000001);
 
-function ImageList_Copy(himlDst:HIMAGELIST;iDst:cint;himlSrc:HIMAGELIST;iSrc:cint;uFlags:UINT):BOOL; external commctrldll name 'ImageList_Copy';
+function ImageList_Copy(himlDst:HIMAGELIST;iDst:cint;himlSrc:HIMAGELIST;iSrc:cint;uFlags:UINT):BOOL; stdcall; external commctrldll name 'ImageList_Copy';
 {$ENDIF}
 
-function ImageList_BeginDrag(himlTrack:HIMAGELIST;iTrack:cint;dxHotspot:cint;dyHotspot:cint):BOOL; external commctrldll name 'ImageList_BeginDrag';
-function ImageList_EndDrag:BOOL; external commctrldll name 'ImageList_EndDrag';
-function ImageList_DragEnter(hwndLock:HWND;x:cint;y:cint):BOOL; external commctrldll name 'ImageList_DragEnter';
-function ImageList_DragLeave(hwndLock:HWND):BOOL; external commctrldll name 'ImageList_DragLeave';
-function ImageList_DragMove(x:cint;y:cint):BOOL; external commctrldll name 'ImageList_DragMove';
-function ImageList_SetDragCursorImage(himlDrag:HIMAGELIST;iDrag:cint;dxHotspot:cint;dyHotspot:cint):BOOL; external commctrldll name 'ImageList_SetDragCursorImage';
+function ImageList_BeginDrag(himlTrack:HIMAGELIST;iTrack:cint;dxHotspot:cint;dyHotspot:cint):BOOL; stdcall; external commctrldll name 'ImageList_BeginDrag';
+function ImageList_EndDrag:BOOL; stdcall; external commctrldll name 'ImageList_EndDrag';
+function ImageList_DragEnter(hwndLock:HWND;x:cint;y:cint):BOOL; stdcall; external commctrldll name 'ImageList_DragEnter';
+function ImageList_DragLeave(hwndLock:HWND):BOOL; stdcall; external commctrldll name 'ImageList_DragLeave';
+function ImageList_DragMove(x:cint;y:cint):BOOL; stdcall; external commctrldll name 'ImageList_DragMove';
+function ImageList_SetDragCursorImage(himlDrag:HIMAGELIST;iDrag:cint;dxHotspot:cint;dyHotspot:cint):BOOL; stdcall; external commctrldll name 'ImageList_SetDragCursorImage';
 
-function ImageList_DragShowNolock(fShow:BOOL):BOOL; external commctrldll name 'ImageList_DragShowNolock';
-function ImageList_GetDragImage(ppt:PPOINT;pptHotspot:PPOINT):HIMAGELIST; external commctrldll name 'ImageList_GetDragImage';
+function ImageList_DragShowNolock(fShow:BOOL):BOOL; stdcall; external commctrldll name 'ImageList_DragShowNolock';
+function ImageList_GetDragImage(ppt:PPOINT;pptHotspot:PPOINT):HIMAGELIST; stdcall; external commctrldll name 'ImageList_GetDragImage';
 
 // Macro 13
 Procedure ImageList_RemoveAll(himl:HIMAGELIST);
@@ -665,8 +665,8 @@ Procedure ImageList_LoadBitmap(hi:HInst;bmp:LPCTSTR;cx:cint;cGrow:cint;crMask:CO
 
 {$IFDEF __IStream_INTERFACE_DEFINED__}
 
-function ImageList_Read(pstm:ISTREAM):HIMAGELIST; external commctrldll name 'ImageList_Read';
-function ImageList_Write(himl:HIMAGELIST;pstm:ISTREAM):BOOL; external commctrldll name 'ImageList_Write';
+function ImageList_Read(pstm:ISTREAM):HIMAGELIST; stdcall; external commctrldll name 'ImageList_Read';
+function ImageList_Write(himl:HIMAGELIST;pstm:ISTREAM):BOOL; stdcall; external commctrldll name 'ImageList_Write';
 
 {$ifdef Win32XP}
 
@@ -675,8 +675,8 @@ CONST
          ILP_DOWNLEVEL                  = 1;                  // Write or reads the stream using downlevel sematics.
 
 
-function ImageList_ReadEx(dwFlags:DWORD;pstm:ISTREAM;riid:REFIID;ppv:PPointer):HRESULT; external commctrldll name 'ImageList_ReadEx';
-function ImageList_WriteEx(himl:HIMAGELIST;dwFlags:DWORD;pstm:ISTREAM):HRESULT; external commctrldll name 'ImageList_WriteEx';
+function ImageList_ReadEx(dwFlags:DWORD;pstm:ISTREAM;riid:REFIID;ppv:PPointer):HRESULT; stdcall; external commctrldll name 'ImageList_ReadEx';
+function ImageList_WriteEx(himl:HIMAGELIST;dwFlags:DWORD;pstm:ISTREAM):HRESULT; stdcall; external commctrldll name 'ImageList_WriteEx';
 {$ENDIF}
 
 {$ENDIF}
@@ -698,14 +698,14 @@ TYPE
 
 {$ENDIF}
 
-function ImageList_GetIconSize(himl:HIMAGELIST;cx:Pint;cy:Pint):BOOL; external commctrldll name 'ImageList_GetIconSize';
-function ImageList_GetIconSize(himl:HIMAGELIST;var cx:cint;var cy:cint):BOOL; external commctrldll name 'ImageList_GetIconSize';
-function ImageList_SetIconSize(himl:HIMAGELIST;cx:cint;cy:cint):BOOL; external commctrldll name 'ImageList_SetIconSize';
-function ImageList_GetImageInfo(himl:HIMAGELIST;i:cint;pImageInfo:PIMAGEINFO):BOOL; external commctrldll name 'ImageList_GetImageInfo';
-function ImageList_GetImageInfo(himl:HIMAGELIST;i:cint;var pImageInfo:_IMAGEINFO):BOOL; external commctrldll name 'ImageList_GetImageInfo';
-function ImageList_Merge(himl1:HIMAGELIST;i1:cint;himl2:HIMAGELIST;i2:cint;dx:cint;dy:cint):HIMAGELIST; external commctrldll name 'ImageList_Merge';
+function ImageList_GetIconSize(himl:HIMAGELIST;cx:Pint;cy:Pint):BOOL; stdcall; external commctrldll name 'ImageList_GetIconSize';
+function ImageList_GetIconSize(himl:HIMAGELIST;var cx:cint;var cy:cint):BOOL; stdcall; external commctrldll name 'ImageList_GetIconSize';
+function ImageList_SetIconSize(himl:HIMAGELIST;cx:cint;cy:cint):BOOL; stdcall; external commctrldll name 'ImageList_SetIconSize';
+function ImageList_GetImageInfo(himl:HIMAGELIST;i:cint;pImageInfo:PIMAGEINFO):BOOL; stdcall; external commctrldll name 'ImageList_GetImageInfo';
+function ImageList_GetImageInfo(himl:HIMAGELIST;i:cint;var pImageInfo:_IMAGEINFO):BOOL; stdcall; external commctrldll name 'ImageList_GetImageInfo';
+function ImageList_Merge(himl1:HIMAGELIST;i1:cint;himl2:HIMAGELIST;i2:cint;dx:cint;dy:cint):HIMAGELIST; stdcall; external commctrldll name 'ImageList_Merge';
 {$ifdef ie4plus}
-function ImageList_Duplicate(himl:HIMAGELIST):HIMAGELIST; external commctrldll name 'ImageList_Duplicate';
+function ImageList_Duplicate(himl:HIMAGELIST):HIMAGELIST; stdcall; external commctrldll name 'ImageList_Duplicate';
 {$ENDIF}
 
 
@@ -1362,9 +1362,9 @@ TYPE
 function CreateToolbarEx(hwnd:HWND;ws:DWORD;wID:UINT;nBitmaps:cint;
                          hBMInst:HINST;
                          wBMID:UINT_PTR;lpButtons:LPCTBBUTTON;iNumButtons:cint;dxButton:cint;
-                         dyButton:cint;dxBitmap:cint;dyBitmap:cint;uStructSize:UINT):HWND; external commctrldll name 'CreateToolbarEx';
+                         dyButton:cint;dxBitmap:cint;dyBitmap:cint;uStructSize:UINT):HWND; stdcall; external commctrldll name 'CreateToolbarEx';
 
-function CreateMappedBitmap(hInstance:HINST;idBitmap:INT_PTR;wFlags:UINT;lpColorMap:LPCOLORMAP;iNumMaps:cint):HBITMAP; external commctrldll name 'CreateMappedBitmap';
+function CreateMappedBitmap(hInstance:HINST;idBitmap:INT_PTR;wFlags:UINT;lpColorMap:LPCOLORMAP;iNumMaps:cint):HBITMAP; stdcall; external commctrldll name 'CreateMappedBitmap';
 
 CONST
          CMB_MASKED                     = $02;
@@ -3006,19 +3006,19 @@ CONST
 
 // end_r_commctrl
 
-procedure DrawStatusTextA(hDC:HDC;lprc:LPRECT;pszText:LPCSTR;uFlags:UINT); external commctrldll name 'DrawStatusTextA';
-Procedure DrawStatusTextW(hDC:HDC;lprc:LPRECT;pszText:LPCWSTR;uFlags:UINT); external commctrldll name 'DrawStatusTextW';
+procedure DrawStatusTextA(hDC:HDC;lprc:LPRECT;pszText:LPCSTR;uFlags:UINT); stdcall; external commctrldll name 'DrawStatusTextA';
+Procedure DrawStatusTextW(hDC:HDC;lprc:LPRECT;pszText:LPCWSTR;uFlags:UINT); stdcall; external commctrldll name 'DrawStatusTextW';
 
-function CreateStatusWindowA(style:LONG;lpszText:LPCSTR;hwndParent:HWND;wID:UINT):HWND; external commctrldll name 'CreateStatusWindowA';
-function CreateStatusWindowW(style:LONG;lpszText:LPCWSTR;hwndParent:HWND;wID:UINT):HWND; external commctrldll name 'CreateStatusWindowW';
+function CreateStatusWindowA(style:LONG;lpszText:LPCSTR;hwndParent:HWND;wID:UINT):HWND; stdcall; external commctrldll name 'CreateStatusWindowA';
+function CreateStatusWindowW(style:LONG;lpszText:LPCWSTR;hwndParent:HWND;wID:UINT):HWND; stdcall; external commctrldll name 'CreateStatusWindowW';
 
 
 {$IFDEF UNICODE}
-function CreateStatusWindow(style:LONG;lpszText:LPCSTR;hwndParent:HWND;wID:UINT):HWND; external commctrldll name 'CreateStatusWindowA';
-procedure DrawStatusText(hDC:HDC;lprc:LPRECT;pszText:LPCSTR;uFlags:UINT); external commctrldll name 'DrawStatusTextA';
+function CreateStatusWindow(style:LONG;lpszText:LPCSTR;hwndParent:HWND;wID:UINT):HWND; stdcall; external commctrldll name 'CreateStatusWindowA';
+procedure DrawStatusText(hDC:HDC;lprc:LPRECT;pszText:LPCSTR;uFlags:UINT); stdcall; external commctrldll name 'DrawStatusTextA';
 {$ELSE}
-function CreateStatusWindow(style:LONG;lpszText:LPCWSTR;hwndParent:HWND;wID:UINT):HWND; external commctrldll name 'CreateStatusWindowW';
-Procedure DrawStatusText(hDC:HDC;lprc:LPRECT;pszText:LPCWSTR;uFlags:UINT); external commctrldll name 'DrawStatusTextW';
+function CreateStatusWindow(style:LONG;lpszText:LPCWSTR;hwndParent:HWND;wID:UINT):HWND; stdcall; external commctrldll name 'CreateStatusWindowW';
+Procedure DrawStatusText(hDC:HDC;lprc:LPRECT;pszText:LPCWSTR;uFlags:UINT); stdcall; external commctrldll name 'DrawStatusTextW';
 {$ENDIF}
 
 CONST
@@ -3106,9 +3106,9 @@ CONST
 
 {$IFNDEF NOMENUHELP}
 
-Procedure MenuHelp(uMsg:UINT;wParam:WPARAM;lParam:LPARAM;hMainMenu:HMENU;hInst:HINST;hwndStatus:HWND;lpwIDs:PUINT); external commctrldll name 'MenuHelp';
-function ShowHideMenuCtl(hWnd:HWND;uFlags:UINT_PTR;lpInfo:LPINT):BOOL; external commctrldll name 'ShowHideMenuCtl';
-Procedure GetEffectiveClientRect(hWnd:HWND;lprc:LPRECT;lpInfo:LPINT); external commctrldll name 'GetEffectiveClientRect';
+Procedure MenuHelp(uMsg:UINT;wParam:WPARAM;lParam:LPARAM;hMainMenu:HMENU;hInst:HINST;hwndStatus:HWND;lpwIDs:PUINT); stdcall; external commctrldll name 'MenuHelp';
+function ShowHideMenuCtl(hWnd:HWND;uFlags:UINT_PTR;lpInfo:LPINT):BOOL; stdcall; external commctrldll name 'ShowHideMenuCtl';
+Procedure GetEffectiveClientRect(hWnd:HWND;lprc:LPRECT;lpInfo:LPINT); stdcall; external commctrldll name 'GetEffectiveClientRect';
 
 CONST
          MINSYSCOMMAND                  = SC_SIZE;
@@ -3259,9 +3259,9 @@ CONST
 
          DRAGLISTMSGSTRING              = 'commctrl_DragListMsg'; // TEXT("commctrl_DragListMsg");
 
-function MakeDragList(hLB:HWND):BOOL; external commctrldll name 'MakeDragList';
-Procedure DrawInsert(handParent:HWND;hLB:HWND;nItem:cint); external commctrldll name 'DrawInsert';
-function LBItemFromPt(hLB:HWND;pt:POINT;bAutoScroll:BOOL):cint; external commctrldll name 'LBItemFromPt';
+function MakeDragList(hLB:HWND):BOOL; stdcall; external commctrldll name 'MakeDragList';
+Procedure DrawInsert(handParent:HWND;hLB:HWND;nItem:cint); stdcall; external commctrldll name 'DrawInsert';
+function LBItemFromPt(hLB:HWND;pt:POINT;bAutoScroll:BOOL):cint; stdcall; external commctrldll name 'LBItemFromPt';
 
 {$ENDIF}
 
@@ -3335,7 +3335,7 @@ CONST
          UDM_GETPOS32                   = (WM_USER+114);
 {$ENDIF}
 
-function CreateUpDownControl(dwStyle:DWORD;x:cint;y:cint;cx:cint;cy:cint;hParent:HWND;nID:cint;hInst:HINST;hBuddy:HWND;nUpper:cint;nLower:cint;nPos:cint):HWND; external commctrldll name 'CreateUpDownControl';
+function CreateUpDownControl(dwStyle:DWORD;x:cint;y:cint;cx:cint;cy:cint;hParent:HWND;nID:cint;hInst:HINST;hBuddy:HWND;nUpper:cint;nLower:cint;nPos:cint):HWND; stdcall; external commctrldll name 'CreateUpDownControl';
 
 TYPE
          _NM_UPDOWN           = Record
@@ -8935,10 +8935,10 @@ CONST
 // === MUI APIs ===
 //
 {$IFNDEF NOMUI}
-procedure InitMUILanguage(uiLang:LANGID); external commctrldll name 'InitMUILanguage';
+procedure InitMUILanguage(uiLang:LANGID); stdcall; external commctrldll name 'InitMUILanguage';
 
 
-function GetMUILanguage:LANGID; external commctrldll name 'GetMUILanguage';
+function GetMUILanguage:LANGID; stdcall; external commctrldll name 'GetMUILanguage';
 {$ENDIF}  // NOMUI
 
 {$ENDIF}      // _WIN32_IE >= 0x0400
@@ -8999,7 +8999,7 @@ TYPE
 // Declare _TrackMouseEvent.  This API tries to use the window manager's
 // implementation of TrackMouseEvent if it is present, otherwise it emulates.
 //
-function _TrackMouseEvent(lpEventTrack:LPTRACKMOUSEEVENT):BOOL; external commctrldll name '_TrackMouseEvent';
+function _TrackMouseEvent(lpEventTrack:LPTRACKMOUSEEVENT):BOOL; stdcall; external commctrldll name '_TrackMouseEvent';
 
 {$ENDIF} // !NOTRACKMOUSEEVENT
 
@@ -9028,35 +9028,35 @@ CONST
          FSB_ENCARTA_MODE               = 1;
          FSB_REGULAR_MODE               = 0;
 
-function FlatSB_EnableScrollBar(hwnd:HWND;code : cint;p3 : UINT):BOOL; external commctrldll name 'FlatSB_EnableScrollBar';
-function FlatSB_ShowScrollBar(hwnd:HWND;code : cint;p3 : BOOL):BOOL; external commctrldll name 'FlatSB_ShowScrollBar';
+function FlatSB_EnableScrollBar(hwnd:HWND;code : cint;p3 : UINT):BOOL; stdcall; external commctrldll name 'FlatSB_EnableScrollBar';
+function FlatSB_ShowScrollBar(hwnd:HWND;code : cint;p3 : BOOL):BOOL; stdcall; external commctrldll name 'FlatSB_ShowScrollBar';
 
-function FlatSB_GetScrollRange(hwnd:HWND;code : cint;p3 : LPINT;p4 : LPINT):BOOL; external commctrldll name 'FlatSB_GetScrollRange';
-function FlatSB_GetScrollRange(hwnd:HWND;code : cint;var p3,p4 : cint):BOOL; external commctrldll name 'FlatSB_GetScrollRange';
-function FlatSB_GetScrollInfo(hwnd:HWND;code : cint;ScrollInfo : LPSCROLLINFO):BOOL; external commctrldll name 'FlatSB_GetScrollInfo';
-function FlatSB_GetScrollInfo(hwnd:HWND;code : cint;var ScrollInfo : TSCROLLINFO):BOOL; external commctrldll name 'FlatSB_GetScrollInfo';
+function FlatSB_GetScrollRange(hwnd:HWND;code : cint;p3 : LPINT;p4 : LPINT):BOOL; stdcall; external commctrldll name 'FlatSB_GetScrollRange';
+function FlatSB_GetScrollRange(hwnd:HWND;code : cint;var p3,p4 : cint):BOOL; stdcall; external commctrldll name 'FlatSB_GetScrollRange';
+function FlatSB_GetScrollInfo(hwnd:HWND;code : cint;ScrollInfo : LPSCROLLINFO):BOOL; stdcall; external commctrldll name 'FlatSB_GetScrollInfo';
+function FlatSB_GetScrollInfo(hwnd:HWND;code : cint;var ScrollInfo : TSCROLLINFO):BOOL; stdcall; external commctrldll name 'FlatSB_GetScrollInfo';
 
-function FlatSB_GetScrollPos(hwnd:HWND;code : cint):cint; external commctrldll name 'FlatSB_GetScrollPos';
+function FlatSB_GetScrollPos(hwnd:HWND;code : cint):cint; stdcall; external commctrldll name 'FlatSB_GetScrollPos';
 
 
-function FlatSB_GetScrollProp(hwnd:HWND):BOOL; external commctrldll name 'FlatSB_GetScrollProp';
+function FlatSB_GetScrollProp(hwnd:HWND):BOOL; stdcall; external commctrldll name 'FlatSB_GetScrollProp';
 {$IFDEF _WIN64}
-function FlatSB_GetScrollPropPtr(hwnd:HWND;propIndex : cint;p3 : LPINT):BOOL; external commctrldll name 'FlatSB_GetScrollPropPtr';
+function FlatSB_GetScrollPropPtr(hwnd:HWND;propIndex : cint;p3 : LPINT):BOOL; stdcall; external commctrldll name 'FlatSB_GetScrollPropPtr';
 {$ELSE}
-function FlatSB_GetScrollPropPtr(hwnd:HWND;code : cint):BOOL; external commctrldll name 'FlatSB_GetScrollProp';
+function FlatSB_GetScrollPropPtr(hwnd:HWND;code : cint):BOOL; stdcall; external commctrldll name 'FlatSB_GetScrollProp';
 {$ENDIF}
 
 
-function FlatSB_SetScrollPos(hWnd:HWND;nBar,nPos:cint;bRedraw:BOOL):cint; external commctrldll name 'FlatSB_SetScrollPos';
+function FlatSB_SetScrollPos(hWnd:HWND;nBar,nPos:cint;bRedraw:BOOL):cint; stdcall; external commctrldll name 'FlatSB_SetScrollPos';
 
-function FlatSB_SetScrollInfo(hWnd:HWND;BarFlag:cint;const ScrollInfo:TScrollInfo;Redraw:BOOL):cint; external commctrldll name 'FlatSB_SetScrollInfo';
+function FlatSB_SetScrollInfo(hWnd:HWND;BarFlag:cint;const ScrollInfo:TScrollInfo;Redraw:BOOL):cint; stdcall; external commctrldll name 'FlatSB_SetScrollInfo';
 
 
-function FlatSB_SetScrollRange(hWnd: HWND; nBar,nMinPos,nMaxPos: cint; bRedraw: BOOL):cint; external commctrldll name 'FlatSB_SetScrollRange';
-function FlatSB_SetScrollProp(p1: HWND; index : UINT; newValue: INT_PTR; p4: BOOL):BOOL; external commctrldll name 'FlatSB_SetScrollProp';
+function FlatSB_SetScrollRange(hWnd: HWND; nBar,nMinPos,nMaxPos: cint; bRedraw: BOOL):cint; stdcall; external commctrldll name 'FlatSB_SetScrollRange';
+function FlatSB_SetScrollProp(p1: HWND; index : UINT; newValue: INT_PTR; p4: BOOL):BOOL; stdcall; external commctrldll name 'FlatSB_SetScrollProp';
 
-function InitializeFlatSB(hWnd:HWND):BOOL; external commctrldll name 'InitializeFlatSB';
-function UninitializeFlatSB(hWnd:HWND):HRESULT; external commctrldll name 'UninitializeFlatSB';
+function InitializeFlatSB(hWnd:HWND):BOOL; stdcall; external commctrldll name 'InitializeFlatSB';
+function UninitializeFlatSB(hWnd:HWND):HRESULT; stdcall; external commctrldll name 'UninitializeFlatSB';
 
 {$ENDIF}  //  NOFLATSBAPIS
 
@@ -9083,17 +9083,17 @@ typedef LRESULT (CALLBACK *SUBCLASSPROC)(HWND hWnd, UINT uMsg, WPARAM wParam,
     hwnd:HWND;uMsg:cUINT; wParam:WPARAM;lparam:LPARAM;uISubClass : CUINT_PTR;dwRefData:DWORD_PTR):LRESULT; stdcall;
 }
 
-function SetWindowSubclass(hWnd:HWND;pfnSubclass:SUBCLASSPROC;uIdSubclass:UINT_PTR;dwRefData:DWORD_PTR):BOOL; external commctrldll name 'SetWindowSubclass';
-function GetWindowSubclass(hWnd:HWND;pfnSubclass:SUBCLASSPROC;uIdSubclass:UINT_PTR;pdwRefData:PDWORD_PTR):BOOL; external commctrldll name 'GetWindowSubclass';
-function RemoveWindowSubclass(hWnd:HWND;pfnSubclass:SUBCLASSPROC;uIdSubclass:UINT_PTR):BOOL; external commctrldll name 'RemoveWindowSubclass';
+function SetWindowSubclass(hWnd:HWND;pfnSubclass:SUBCLASSPROC;uIdSubclass:UINT_PTR;dwRefData:DWORD_PTR):BOOL; stdcall; external commctrldll name 'SetWindowSubclass';
+function GetWindowSubclass(hWnd:HWND;pfnSubclass:SUBCLASSPROC;uIdSubclass:UINT_PTR;pdwRefData:PDWORD_PTR):BOOL; stdcall; external commctrldll name 'GetWindowSubclass';
+function RemoveWindowSubclass(hWnd:HWND;pfnSubclass:SUBCLASSPROC;uIdSubclass:UINT_PTR):BOOL; stdcall; external commctrldll name 'RemoveWindowSubclass';
 
-function DefSubclassProc(hWnd:HWND;uMsg:UINT;wParam:WPARAM;lParam:LPARAM):LRESULT; external commctrldll name 'DefSubclassProc';
+function DefSubclassProc(hWnd:HWND;uMsg:UINT;wParam:WPARAM;lParam:LPARAM):LRESULT; stdcall; external commctrldll name 'DefSubclassProc';
 {$ENDIF}
 
 
 {$ifdef win32xp}
 
-function DrawShadowText(hdc:HDC;pszText:LPCWSTR;cch:UINT;prc:PRECT;dwFlags:DWORD;crText:COLORREF;crShadow:COLORREF;ixOffset:cint;iyOffset:cint):cint; external commctrldll name 'DrawShadowText';
+function DrawShadowText(hdc:HDC;pszText:LPCWSTR;cch:UINT;prc:PRECT;dwFlags:DWORD;crText:COLORREF;crShadow:COLORREF;ixOffset:cint;iyOffset:cint):cint; stdcall; external commctrldll name 'DrawShadowText';
 {$ENDIF}
 
 

packages/base/winunits/comobj.pp

@@ -64,17 +64,43 @@ unit comobj;
         property StartSuspended: Boolean read GetStartSuspended;
       end;
 
-    {
+      TComObjectFactory = class;
+
+      TFactoryProc = procedure(Factory: TComObjectFactory) of object;
+
+      TComClassManager = class(TObject)
+        constructor Create;
+        destructor Destroy; override;
+        procedure ForEachFactory(ComServer: TComServerObject; FactoryProc: TFactoryProc);
+        function GetFactoryFromClass(ComClass: TClass): TComObjectFactory;
+        function GetFactoryFromClassID(const ClassID: TGUID): TComObjectFactory;
+      end;
+
+      IServerExceptionHandler = interface
+        ['{6A8D432B-EB81-11D1-AAB1-00C04FB16FBC}']
+        procedure OnException(const ServerClass, ExceptionClass, ErrorMessage: WideString;
+          ExceptAddr: PtrInt; const ErrorIID, ProgID: WideString; var Handled: Integer; var Result: HResult); dispid 2;
+      end;
+
       TComObject = class(TObject, IUnknown, ISupportErrorInfo)
+      private
+        FController : Pointer;
+        FFactory : TComObjectFactory;
+        FRefCount : Integer;
+        FServerExceptionHandler : IServerExceptionHandler;
+        FCounted : Boolean;
+        function GetController : IUnknown;
       protected
         { IUnknown }
         function IUnknown.QueryInterface = ObjQueryInterface;
         function IUnknown._AddRef = ObjAddRef;
         function IUnknown._Release = ObjRelease;
+
         { IUnknown methods for other interfaces }
         function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
         function _AddRef: Integer; stdcall;
         function _Release: Integer; stdcall;
+
         { ISupportErrorInfo }
         function InterfaceSupportsErrorInfo(const iid: TIID): HResult; stdcall;
       public
@@ -87,12 +113,67 @@ unit comobj;
         function ObjQueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
         function ObjRelease: Integer; virtual; stdcall;
         function SafeCallException(ExceptObject: TObject; ExceptAddr: Pointer): HResult; override;
-        property Controller: IUnknown;
-        property Factory: TComObjectFactory;
-        property RefCount: Integer;
-        property ServerExceptionHandler: IServerExceptionHandler;
+        property Controller: IUnknown read GetController;
+        property Factory: TComObjectFactory read FFactory;
+        property RefCount: Integer read FRefCount;
+        property ServerExceptionHandler: IServerExceptionHandler read FServerExceptionHandler write FServerExceptionHandler;
+      end;
+      TComClass = class of TComObject;
+
+      TClassInstancing = (ciInternal, ciSingleInstance, ciMultiInstance);
+      TThreadingModel = (tmSingle, tmApartment, tmFree, tmBoth, tmNeutral);
+
+      TComObjectFactory = class(TObject, IUnknown, IClassFactory, IClassFactory2)
+      private
+        Next: TComObjectFactory;
+        FComServer: TComServerObject;
+        FComClass: TClass;
+        FClassID: TGUID;
+        FClassName: string;
+        FDescription: string;
+        FErrorIID: TGUID;
+        FInstancing: TClassInstancing;
+        FLicString: WideString;
+        FRegister: Longint;
+        FShowErrors: Boolean;
+        FSupportsLicensing: Boolean;
+        FThreadingModel: TThreadingModel;
+        function GetProgID: string;
+      protected
+        { IUnknown }
+        function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
+        function _AddRef: Integer; stdcall;
+        function _Release: Integer; stdcall;
+        { IClassFactory }
+        function CreateInstance(const UnkOuter: IUnknown; const IID: TGUID;
+          out Obj): HResult; stdcall;
+        function LockServer(fLock: BOOL): HResult; stdcall;
+        { IClassFactory2 }
+        function GetLicInfo(var licInfo: TLicInfo): HResult; stdcall;
+        function RequestLicKey(dwResrved: DWORD; out bstrKey: WideString): HResult; stdcall;
+        function CreateInstanceLic(const unkOuter: IUnknown; const unkReserved: IUnknown;
+          const iid: TIID; const bstrKey: WideString; out vObject): HResult; stdcall;
+      public
+        constructor Create(ComServer: TComServerObject; ComClass: TComClass;
+          const ClassID: TGUID; const Name, Description: string;
+          Instancing: TClassInstancing; ThreadingModel: TThreadingModel = tmSingle);
+        destructor Destroy; override;
+        function CreateComObject(const Controller: IUnknown): TComObject; virtual;
+        procedure RegisterClassObject;
+        procedure UpdateRegistry(Register: Boolean); virtual;
+        property ClassID: TGUID read FClassID;
+        property ClassName: string read FClassName;
+        property ComClass: TClass read FComClass;
+        property ComServer: TComServerObject read FComServer;
+        property Description: string read FDescription;
+        property ErrorIID: TGUID read FErrorIID write FErrorIID;
+        property LicString: WideString read FLicString write FLicString;
+        property ProgID: string read GetProgID;
+        property Instancing: TClassInstancing read FInstancing;
+        property ShowErrors: Boolean read FShowErrors write FShowErrors;
+        property SupportsLicensing: Boolean read FSupportsLicensing write FSupportsLicensing;
+        property ThreadingModel: TThreadingModel read FThreadingModel;
       end;
-    }
 
     function CreateClassID : ansistring;
 
@@ -110,6 +191,11 @@ unit comobj;
        DispIDs: PDispIDList; Params: Pointer; Result: PVariant);
     procedure DispatchInvokeError(Status: HRESULT; const ExceptInfo: TExcepInfo);
 
+    function HandleSafeCallException(ExceptObject: TObject; ExceptAddr: Pointer; const ErrorIID: TGUID; const ProgID,
+      HelpFileName: WideString): HResult;
+
+    function ComClassManager : TComClassManager;
+
     type
       TCoCreateInstanceExProc = function(const clsid: TCLSID; unkOuter: IUnknown; dwClsCtx: DWORD; ServerInfo: PCoServerInfo;
       dwCount: ULONG; rgmqResults: PMultiQIArray): HResult stdcall;
@@ -133,6 +219,36 @@ implementation
     uses
       ComConst,Ole2;
 
+    var
+      Uninitializing : boolean;
+
+    function HandleSafeCallException(ExceptObject: TObject; ExceptAddr: Pointer; const ErrorIID: TGUID; const ProgID,
+      HelpFileName: WideString): HResult;
+      var
+        _CreateErrorInfo : ICreateErrorInfo;
+        ErrorInfo : IErrorInfo;
+      begin
+        Result:=E_UNEXPECTED;
+        if Succeeded(CreateErrorInfo(_CreateErrorInfo)) then
+          begin
+            _CreateErrorInfo.SetGUID(ErrorIID);
+            if ProgID<>'' then
+              _CreateErrorInfo.SetSource(PWidechar(ProgID));
+            if HelpFileName<>'' then
+              _CreateErrorInfo.SetHelpFile(PWidechar(HelpFileName));
+            if ExceptObject is Exception then
+              begin
+                _CreateErrorInfo.SetDescription(PWidechar(Widestring(Exception(ExceptObject).Message)));
+                _CreateErrorInfo.SetHelpContext(Exception(ExceptObject).HelpContext);
+                if (ExceptObject is EOleSyserror) and (EOleSysError(ExceptObject).ErrorCode<0) then
+                  Result:=EOleSysError(ExceptObject).ErrorCode
+              end;
+            if _CreateErrorInfo.QueryInterface(IErrorInfo,ErrorInfo)=S_OK then
+              SetErrorInfo(0,ErrorInfo);
+          end;
+      end;
+
+
     constructor EOleSysError.Create(const Msg: string; aErrorCode: HRESULT; aHelpContext: Integer);
       var
         m : string;
@@ -274,6 +390,270 @@ implementation
           raise EOleSysError.Create('',Status,0);
       end;
 
+    var
+      _ComClassManager : TComClassManager;
+
+    function ComClassManager: TComClassManager;
+      begin
+        if not(assigned(_ComClassManager)) then
+          _ComClassManager:=TComClassManager.Create;
+        Result:=_ComClassManager;
+      end;
+
+
+    constructor TComClassManager.Create;
+      begin
+        RunError(217);
+      end;
+
+
+    destructor TComClassManager.Destroy;
+      begin
+        RunError(217);
+      end;
+
+
+    procedure TComClassManager.ForEachFactory(ComServer: TComServerObject;
+      FactoryProc: TFactoryProc);
+      begin
+        RunError(217);
+      end;
+
+
+    function TComClassManager.GetFactoryFromClass(ComClass: TClass
+      ): TComObjectFactory;
+      begin
+        RunError(217);
+      end;
+
+
+    function TComClassManager.GetFactoryFromClassID(const ClassID: TGUID
+      ): TComObjectFactory;
+      begin
+        RunError(217);
+      end;
+
+
+    function TComObject.GetController: IUnknown;
+      begin
+        Result:=IUnknown(Controller);
+      end;
+
+
+    function TComObject.QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
+      begin
+        if assigned(FController) then
+          Result:=IUnknown(FController).QueryInterface(IID,Obj)
+        else
+          Result:=ObjQueryInterface(IID,Obj);
+      end;
+
+
+    function TComObject._AddRef: Integer; stdcall;
+      begin
+        if assigned(FController) then
+          Result:=IUnknown(FController)._AddRef
+        else
+          Result:=ObjAddRef;
+      end;
+
+
+    function TComObject._Release: Integer; stdcall;
+      begin
+        if assigned(FController) then
+          Result:=IUnknown(FController)._Release
+        else
+          Result:=ObjRelease;
+      end;
+
+
+    function TComObject.InterfaceSupportsErrorInfo(const iid: TIID): HResult; stdcall;
+      begin
+        if assigned(GetInterfaceEntry(iid)) then
+          Result:=S_OK
+        else
+          Result:=S_FALSE;
+      end;
+
+
+    constructor TComObject.Create;
+      begin
+         CreateFromFactory(ComClassManager.GetFactoryFromClass(ClassType),nil);
+      end;
+
+
+    constructor TComObject.CreateAggregated(const Controller: IUnknown);
+      begin
+        CreateFromFactory(ComClassManager.GetFactoryFromClass(ClassType),Controller);
+      end;
+
+
+    constructor TComObject.CreateFromFactory(Factory: TComObjectFactory;
+      const Controller: IUnknown);
+      begin
+        FFactory:=Factory;
+        FRefCount:=1;
+        FController:=Pointer(Controller);
+        FFactory.Comserver.CountObject(True);
+        FCounted:=true;
+        Initialize;
+        Dec(FRefCount);
+      end;
+
+
+    destructor TComObject.Destroy;
+      begin
+        if not(Uninitializing) then
+          begin
+            if assigned(FFactory) and FCounted then
+              FFactory.Comserver.CountObject(false);
+            if FRefCount>0 then
+              CoDisconnectObject(Self,0);
+          end;
+      end;
+
+
+    procedure TComObject.Initialize;
+      begin
+      end;
+
+
+    function TComObject.ObjAddRef: Integer; stdcall;
+      begin
+        Result:=InterlockedIncrement(FRefCount);
+      end;
+
+
+    function TComObject.ObjQueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
+      begin
+        if GetInterface(IID,Obj) then
+          Result:=S_OK
+        else
+          Result:=E_NOINTERFACE;
+      end;
+
+
+    function TComObject.ObjRelease: Integer; stdcall;
+      begin
+        Result:=InterlockedDecrement(FRefCount);
+        if Result=0 then
+          Self.Destroy;
+      end;
+
+
+    function TComObject.SafeCallException(ExceptObject: TObject; ExceptAddr: Pointer): HResult;
+      var
+        Message: string;
+        Handled: Integer;
+      begin
+        Handled:=0;
+        Result:=0;
+        if assigned(ServerExceptionHandler) then
+          begin
+            if ExceptObject is Exception then
+              Message:=Exception(ExceptObject).Message;
+
+            ServerExceptionHandler.OnException(ClassName,ExceptObject.ClassName,
+              Message,PtrInt(ExceptAddr),WideString(GUIDToString(FFactory.ErrorIID)),
+              FFactory.ProgID,Handled,Result);
+          end;
+        if Handled=0 then
+          Result:=HandleSafeCallException(ExceptObject,ExceptAddr,FFactory.ErrorIID,
+            FFactory.ProgID,FFactory.ComServer.HelpFileName);
+      end;
+
+
+    function TComObjectFactory.GetProgID: string;
+      begin
+        RunError(217);
+      end;
+
+
+    function TComObjectFactory.QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
+      begin
+        RunError(217);
+      end;
+
+
+    function TComObjectFactory._AddRef: Integer; stdcall;
+      begin
+        RunError(217);
+      end;
+
+
+    function TComObjectFactory._Release: Integer; stdcall;
+      begin
+        RunError(217);
+      end;
+
+
+    function TComObjectFactory.CreateInstance(const UnkOuter: IUnknown;
+      const IID: TGUID; out Obj): HResult; stdcall;
+      begin
+        RunError(217);
+      end;
+
+
+    function TComObjectFactory.LockServer(fLock: BOOL): HResult; stdcall;
+      begin
+        RunError(217);
+      end;
+
+
+    function TComObjectFactory.GetLicInfo(var licInfo: TLicInfo): HResult; stdcall;
+      begin
+        RunError(217);
+      end;
+
+
+    function TComObjectFactory.RequestLicKey(dwResrved: DWORD; out bstrKey: WideString): HResult; stdcall;
+      begin
+        RunError(217);
+      end;
+
+
+    function TComObjectFactory.CreateInstanceLic(const unkOuter: IUnknown;
+      const unkReserved: IUnknown; const iid: TIID; const bstrKey: WideString; out
+      vObject): HResult; stdcall;
+      begin
+        RunError(217);
+      end;
+
+
+    constructor TComObjectFactory.Create(ComServer: TComServerObject;
+      ComClass: TComClass; const ClassID: TGUID; const Name,
+      Description: string; Instancing: TClassInstancing;
+      ThreadingModel: TThreadingModel);
+      begin
+        RunError(217);
+      end;
+
+
+    destructor TComObjectFactory.Destroy;
+      begin
+        RunError(217);
+      end;
+
+
+    function TComObjectFactory.CreateComObject(const Controller: IUnknown
+      ): TComObject;
+      begin
+        RunError(217);
+      end;
+
+
+    procedure TComObjectFactory.RegisterClassObject;
+      begin
+        RunError(217);
+      end;
+
+
+    procedure TComObjectFactory.UpdateRegistry(Register: Boolean);
+      begin
+        RunError(217);
+      end;
+
+
 { $define DEBUG_COMDISPATCH}
     procedure DispatchInvoke(const Dispatch: IDispatch; CallDesc: PCallDesc;
       DispIDs: PDispIDList; Params: Pointer; Result: PVariant);
@@ -634,7 +1014,10 @@ const
   Initialized : boolean = false;
 var
   Ole32Dll : HModule;
+
 initialization
+  Uninitializing:=false;
+  _ComClassManager:=nil;
   Ole32Dll:=GetModuleHandle('ole32.dll');
   if Ole32Dll<>0 then
     begin
@@ -652,6 +1035,8 @@ initialization
   VarDispProc:=@ComObjDispatchInvoke;
   DispCallByIDProc:=@DoDispCallByID;
 finalization
+  Uninitializing:=true;
+  _ComClassManager.Free;
   VarDispProc:=nil;
   SafeCallErrorProc:=nil;
   if Initialized then

packages/base/winunits/flatsb.pp

@@ -0,0 +1,115 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2007 by the Free Pascal development team
+    member of the Free Pascal development team.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{$mode objfpc}
+{$H+}
+{$inline on}
+unit FlatSB;
+
+  interface
+
+    uses
+      ctypes,Windows;
+
+    function InitializeFlatSB(hWnd: HWND): Bool; stdcall;
+    procedure UninitializeFlatSB(hWnd: HWND); stdcall;
+    function FlatSB_GetScrollProp(hwnd:HWND;propIndex : cint;p3 : LPINT):BOOL; stdcall;
+    function FlatSB_SetScrollProp(p1: HWND; index : UINT; newValue: INT_PTR; p4: BOOL):BOOL; stdcall;
+
+    var
+      FlatSB_EnableScrollBar: function(hwnd:HWND;code : cint;p3 : UINT):BOOL; stdcall;
+      FlatSB_ShowScrollBar: function(hwnd:HWND;code : cint;p3 : BOOL):BOOL; stdcall;
+      FlatSB_GetScrollRange: function(hwnd:HWND;code : cint;var p3,p4 : cint):BOOL; stdcall;
+      FlatSB_GetScrollInfo: function(hwnd:HWND;code : cint;var ScrollInfo : TSCROLLINFO):BOOL; stdcall;
+      FlatSB_GetScrollPos: function(hwnd:HWND;code : cint):cint; stdcall;
+      FlatSB_SetScrollPos: function(hWnd:HWND;nBar,nPos:cint;bRedraw:BOOL):cint; stdcall;
+      FlatSB_SetScrollInfo: function(hWnd:HWND;BarFlag:cint;const ScrollInfo:TScrollInfo;Redraw:BOOL):cint; stdcall;
+      FlatSB_SetScrollRange: function(hWnd: HWND; nBar,nMinPos,nMaxPos: cint; bRedraw: BOOL):cint; stdcall;
+
+  implementation
+
+    var
+      Internal_FlatSB_GetScrollProp: function(hwnd:HWND;propIndex : cint;p3 : LPINT):BOOL; stdcall;
+      Internal_FlatSB_SetScrollProp: function(p1: HWND; index : UINT; newValue: INT_PTR; p4: BOOL):BOOL; stdcall;
+      Internal_InitializeFlatSB: function(hWnd: HWND): Bool; stdcall;
+      Internal_UninitializeFlatSB: procedure(hWnd: HWND); stdcall;
+
+
+    function FlatSB_GetScrollProp(hwnd:HWND;propIndex : cint;p3 : LPINT):BOOL; stdcall;
+      begin
+        Result:=Assigned(Internal_FlatSB_GetScrollProp) and Internal_FlatSB_GetScrollProp(hwnd,propIndex, p3);
+      end;
+
+
+    function FlatSB_SetScrollProp(p1: HWND; index : UINT; newValue: INT_PTR; p4: BOOL):BOOL; stdcall;
+      begin
+        Result:=Assigned(Internal_FlatSB_SetScrollProp) and Internal_FlatSB_SetScrollProp(p1,index,newValue,p4);
+      end;
+
+
+    function InitializeFlatSB(hWnd: HWND): Bool; stdcall;
+      begin
+        Result:=Assigned(Internal_InitializeFlatSB) and Internal_InitializeFlatSB(hWnd);
+      end;
+
+
+    procedure UninitializeFlatSB(hWnd: HWND); stdcall;
+      begin
+        if Assigned(Internal_UninitializeFlatSB) then
+          Internal_UninitializeFlatSB(hWnd);
+      end;
+
+    var
+      handle : THandle;
+    begin
+      handle:=GetModuleHandle('comctrl32.dll');
+      if handle<>0 then
+        begin
+          pointer(Internal_InitializeFlatSB):=GetProcAddress(handle,'InitializeFlatSB');
+          pointer(Internal_UninitializeFlatSB):=GetProcAddress(handle,'UninitializeFlatSB');
+          pointer(Internal_FlatSB_GetScrollProp):=GetProcAddress(handle,'FlatSB_GetScrollProp');
+          pointer(Internal_FlatSB_SetScrollProp):=GetProcAddress(handle,'FlatSB_SetScrollProp');
+
+          pointer(FlatSB_EnableScrollBar):=GetProcAddress(handle,'FlatSB_EnableScrollBar');
+          if not(assigned(FlatSB_EnableScrollBar)) then
+            pointer(FlatSB_EnableScrollBar):=pointer(@EnableScrollBar);
+
+          pointer(FlatSB_ShowScrollBar):=GetProcAddress(handle,'FlatSB_ShowScrollBar');
+          if not(assigned(FlatSB_ShowScrollBar)) then
+            pointer(FlatSB_ShowScrollBar):=pointer(@ShowScrollBar);
+
+          pointer(FlatSB_GetScrollRange):=GetProcAddress(handle,'FlatSB_GetScrollRange');
+          if not(assigned(FlatSB_GetScrollRange)) then
+            pointer(FlatSB_GetScrollRange):=pointer(@GetScrollRange);
+
+          pointer(FlatSB_GetScrollInfo):=GetProcAddress(handle,'FlatSB_GetScrollInfo');
+          if not(assigned(FlatSB_GetScrollInfo)) then
+            pointer(FlatSB_GetScrollInfo):=pointer(@GetScrollInfo);
+
+          pointer(FlatSB_GetScrollPos):=GetProcAddress(handle,'FlatSB_GetScrollPos');
+          if not(assigned(FlatSB_GetScrollPos)) then
+            pointer(FlatSB_GetScrollPos):=pointer(@GetScrollPos);
+
+          pointer(FlatSB_SetScrollPos):=GetProcAddress(handle,'FlatSB_SetScrollPos');
+          if not(assigned(FlatSB_SetScrollPos)) then
+            pointer(FlatSB_SetScrollPos):=pointer(@SetScrollPos);
+
+          pointer(FlatSB_SetScrollInfo):=GetProcAddress(handle,'FlatSB_SetScrollInfo');
+          if not(assigned(FlatSB_SetScrollInfo)) then
+            pointer(FlatSB_SetScrollInfo):=pointer(@SetScrollInfo);
+
+          pointer(FlatSB_SetScrollRange):=GetProcAddress(handle,'FlatSB_SetScrollRange');
+          if not(assigned(FlatSB_SetScrollRange)) then
+            pointer(FlatSB_SetScrollRange):=pointer(@SetScrollRange);
+        end;
+    end.

packages/extra/gtk2/pango/pango-font.inc

@@ -193,7 +193,7 @@ function pango_font_description_get_stretch(desc:PPangoFontDescription):TPangoSt
 procedure pango_font_description_set_size(desc:PPangoFontDescription; size:gint); cdecl; external pangolib;
 function pango_font_description_get_size(desc:PPangoFontDescription):gint; cdecl; external pangolib;
 procedure pango_font_description_set_absolute_size(desc:PPangoFontDescription;size:double); cdecl; external pangolib;
-function pango_font_description_get_size_is_absolute (desc:PPangoFontDescription;size:double):gboolean; cdecl; external pangolib;
+function pango_font_description_get_size_is_absolute (desc:PPangoFontDescription):gboolean; cdecl; external pangolib;
 function pango_font_description_get_set_fields(desc:PPangoFontDescription):TPangoFontMask; cdecl; external pangolib;
 procedure pango_font_description_unset_fields(desc:PPangoFontDescription; to_unset:TPangoFontMask); cdecl; external pangolib;
 procedure pango_font_description_merge(desc:PPangoFontDescription; desc_to_merge:PPangoFontDescription; replace_existing:gboolean); cdecl; external pangolib;

packages/extra/gtk2/pango/pango-layout.inc

@@ -50,6 +50,7 @@ procedure pango_layout_set_text(layout:PPangoLayout; text:Pchar; length:longint)
 function pango_layout_get_text(layout:PPangoLayout):Pchar; cdecl; external pangolib;
 procedure pango_layout_set_markup(layout:PPangoLayout; markup:Pchar; length:longint); cdecl; external pangolib;
 procedure pango_layout_set_markup_with_accel(layout:PPangoLayout; markup:Pchar; length:longint; accel_marker:gunichar; accel_char:Pgunichar); cdecl; external pangolib;
+function pango_layout_get_font_description(layout:PPangoLayout):PPangoFontDescription; cdecl; external pangolib;
 procedure pango_layout_set_font_description(layout:PPangoLayout; desc:PPangoFontDescription); cdecl; external pangolib;
 procedure pango_layout_set_width(layout:PPangoLayout; width:longint); cdecl; external pangolib;
 function pango_layout_get_width(layout:PPangoLayout):longint; cdecl; external pangolib;

packages/extra/oggvorbis/vorbis.pas

@@ -19,6 +19,7 @@ unit vorbis;
 
 {$mode objfpc}
 {$MINENUMSIZE 4}
+{$PACKRECORDS C}
 
 interface
 
@@ -440,7 +441,7 @@ begin
   while num > 0 do
   begin
     res := ov_read(vf, pointer(ptrint(buffer) + ofs), num, bigendianp, word, sgned, nil);
-    if res <= 0 then
+    if res < 0 then
       Exit(res);
 
     if res = 0 then

packages/extra/openssl/openssl.pas

@@ -67,7 +67,7 @@ requested OpenSSL function just return errorcode.
 interface
 
 uses
-  DynLibs;
+  DynLibs, cTypes;
 
 var
   {$IFDEF WINDOWS}
@@ -95,13 +95,12 @@ type
   PX509 = SslPtr;
   PX509_NAME = SslPtr;
   PEVP_MD	= SslPtr;
-  PInteger = ^Integer;
   PBIO_METHOD = SslPtr;
   PBIO = SslPtr;
   EVP_PKEY = SslPtr;
   PRSA = SslPtr;
   PASN1_UTCTIME = SslPtr;
-  PASN1_INTEGER = SslPtr;
+  PASN1_cInt = SslPtr;
   PPasswdCb = SslPtr;
   PFunction = procedure;
 
@@ -109,7 +108,7 @@ type
   PDES_cblock = ^DES_cblock;
   des_ks_struct = packed record
     ks: DES_cblock;
-    weak_key: Integer;
+    weak_key: cInt;
   end;
   des_key_schedule = array[1..16] of des_ks_struct;
 
@@ -186,104 +185,104 @@ var
   SSLUtilFile: string = '';
 
 // libssl.dll
-  function SslGetError(s: PSSL; ret_code: Integer):Integer;
-  function SslLibraryInit:Integer;
+  function SslGetError(s: PSSL; ret_code: cInt):cInt;
+  function SslLibraryInit:cInt;
   procedure SslLoadErrorStrings;
-//  function SslCtxSetCipherList(arg0: PSSL_CTX; str: PChar):Integer;
-  function SslCtxSetCipherList(arg0: PSSL_CTX; var str: String):Integer;
+//  function SslCtxSetCipherList(arg0: PSSL_CTX; str: PChar):cInt;
+  function SslCtxSetCipherList(arg0: PSSL_CTX; var str: String):cInt;
   function SslCtxNew(meth: PSSL_METHOD):PSSL_CTX;
   procedure SslCtxFree(arg0: PSSL_CTX);
-  function SslSetFd(s: PSSL; fd: Integer):Integer;
+  function SslSetFd(s: PSSL; fd: cInt):cInt;
   function SslMethodV2:PSSL_METHOD;
   function SslMethodV3:PSSL_METHOD;
   function SslMethodTLSV1:PSSL_METHOD;
   function SslMethodV23:PSSL_METHOD;
-  function SslCtxUsePrivateKey(ctx: PSSL_CTX; pkey: SslPtr):Integer;
-  function SslCtxUsePrivateKeyASN1(pk: integer; ctx: PSSL_CTX; d: String; len: integer):Integer;
-//  function SslCtxUsePrivateKeyFile(ctx: PSSL_CTX; const _file: PChar; _type: Integer):Integer;
-  function SslCtxUsePrivateKeyFile(ctx: PSSL_CTX; const _file: String; _type: Integer):Integer;
-  function SslCtxUseCertificate(ctx: PSSL_CTX; x: SslPtr):Integer;
-  function SslCtxUseCertificateASN1(ctx: PSSL_CTX; len: integer; d: String):Integer;
-  function SslCtxUseCertificateFile(ctx: PSSL_CTX; const _file: String; _type: Integer):Integer;
-//  function SslCtxUseCertificateChainFile(ctx: PSSL_CTX; const _file: PChar):Integer;
-  function SslCtxUseCertificateChainFile(ctx: PSSL_CTX; const _file: String):Integer;
-  function SslCtxCheckPrivateKeyFile(ctx: PSSL_CTX):Integer;
+  function SslCtxUsePrivateKey(ctx: PSSL_CTX; pkey: SslPtr):cInt;
+  function SslCtxUsePrivateKeyASN1(pk: cInt; ctx: PSSL_CTX; d: String; len: cLong):cInt;
+//  function SslCtxUsePrivateKeyFile(ctx: PSSL_CTX; const _file: PChar; _type: cInt):cInt;
+  function SslCtxUsePrivateKeyFile(ctx: PSSL_CTX; const _file: String; _type: cInt):cInt;
+  function SslCtxUseCertificate(ctx: PSSL_CTX; x: SslPtr):cInt;
+  function SslCtxUseCertificateASN1(ctx: PSSL_CTX; len: cLong; d: String):cInt;
+  function SslCtxUseCertificateFile(ctx: PSSL_CTX; const _file: String; _type: cInt):cInt;
+//  function SslCtxUseCertificateChainFile(ctx: PSSL_CTX; const _file: PChar):cInt;
+  function SslCtxUseCertificateChainFile(ctx: PSSL_CTX; const _file: String):cInt;
+  function SslCtxCheckPrivateKeyFile(ctx: PSSL_CTX):cInt;
   procedure SslCtxSetDefaultPasswdCb(ctx: PSSL_CTX; cb: PPasswdCb);
   procedure SslCtxSetDefaultPasswdCbUserdata(ctx: PSSL_CTX; u: SslPtr);
-//  function SslCtxLoadVerifyLocations(ctx: PSSL_CTX; const CAfile: PChar; const CApath: PChar):Integer;
-  function SslCtxLoadVerifyLocations(ctx: PSSL_CTX; const CAfile: String; const CApath: String):Integer;
+//  function SslCtxLoadVerifyLocations(ctx: PSSL_CTX; const CAfile: PChar; const CApath: PChar):cInt;
+  function SslCtxLoadVerifyLocations(ctx: PSSL_CTX; const CAfile: String; const CApath: String):cInt;
   function SslNew(ctx: PSSL_CTX):PSSL;
   procedure SslFree(ssl: PSSL);
-  function SslAccept(ssl: PSSL):Integer;
-  function SslConnect(ssl: PSSL):Integer;
-  function SslShutdown(ssl: PSSL):Integer;
-  function SslRead(ssl: PSSL; buf: SslPtr; num: Integer):Integer;
-  function SslPeek(ssl: PSSL; buf: SslPtr; num: Integer):Integer;
-  function SslWrite(ssl: PSSL; buf: SslPtr; num: Integer):Integer;
-  function SslPending(ssl: PSSL):Integer;
+  function SslAccept(ssl: PSSL):cInt;
+  function SslConnect(ssl: PSSL):cInt;
+  function SslShutdown(ssl: PSSL):cInt;
+  function SslRead(ssl: PSSL; buf: SslPtr; num: cInt):cInt;
+  function SslPeek(ssl: PSSL; buf: SslPtr; num: cInt):cInt;
+  function SslWrite(ssl: PSSL; buf: SslPtr; num: cInt):cInt;
+  function SslPending(ssl: PSSL):cInt;
   function SslGetVersion(ssl: PSSL):String;
   function SslGetPeerCertificate(ssl: PSSL):PX509;
-  procedure SslCtxSetVerify(ctx: PSSL_CTX; mode: Integer; arg2: PFunction);
+  procedure SslCtxSetVerify(ctx: PSSL_CTX; mode: cInt; arg2: PFunction);
   function SSLGetCurrentCipher(s: PSSL):SslPtr;
   function SSLCipherGetName(c: SslPtr): String;
-  function SSLCipherGetBits(c: SslPtr; var alg_bits: Integer):Integer;
-  function SSLGetVerifyResult(ssl: PSSL):Integer;
+  function SSLCipherGetBits(c: SslPtr; var alg_bits: cInt):cInt;
+  function SSLGetVerifyResult(ssl: PSSL):cLong;
 
 // libeay.dll
   function X509New: PX509;
   procedure X509Free(x: PX509);
-  function X509NameOneline(a: PX509_NAME; var buf: String; size: Integer):String;
+  function X509NameOneline(a: PX509_NAME; var buf: String; size: cInt):String;
   function X509GetSubjectName(a: PX509):PX509_NAME;
   function X509GetIssuerName(a: PX509):PX509_NAME;
-  function X509NameHash(x: PX509_NAME):Cardinal;
-//  function SslX509Digest(data: PX509; _type: PEVP_MD; md: PChar; len: PInteger):Integer;
-  function X509Digest(data: PX509; _type: PEVP_MD; md: String; var len: Integer):Integer;
-  function X509print(b: PBIO; a: PX509): integer;
-  function X509SetVersion(x: PX509; version: integer): integer;
-  function X509SetPubkey(x: PX509; pkey: EVP_PKEY): integer;
-  function X509SetIssuerName(x: PX509; name: PX509_NAME): integer;
-  function X509NameAddEntryByTxt(name: PX509_NAME; field: string; _type: integer;
-    bytes: string; len, loc, _set: integer): integer;
-  function X509Sign(x: PX509; pkey: EVP_PKEY; const md: PEVP_MD): integer;
-  function X509GmtimeAdj(s: PASN1_UTCTIME; adj: integer): PASN1_UTCTIME;
-  function X509SetNotBefore(x: PX509; tm: PASN1_UTCTIME): integer;
-  function X509SetNotAfter(x: PX509; tm: PASN1_UTCTIME): integer;
-  function X509GetSerialNumber(x: PX509): PASN1_INTEGER;
+  function X509NameHash(x: PX509_NAME):cuLong;
+//  function SslX509Digest(data: PX509; _type: PEVP_MD; md: PChar; len: PcInt):cInt;
+  function X509Digest(data: PX509; _type: PEVP_MD; md: String; var len: cInt):cInt;
+  function X509print(b: PBIO; a: PX509): cInt;
+  function X509SetVersion(x: PX509; version: cInt): cInt;
+  function X509SetPubkey(x: PX509; pkey: EVP_PKEY): cInt;
+  function X509SetIssuerName(x: PX509; name: PX509_NAME): cInt;
+  function X509NameAddEntryByTxt(name: PX509_NAME; field: string; _type: cInt;
+    bytes: string; len, loc, _set: cInt): cInt;
+  function X509Sign(x: PX509; pkey: EVP_PKEY; const md: PEVP_MD): cInt;
+  function X509GmtimeAdj(s: PASN1_UTCTIME; adj: cInt): PASN1_UTCTIME;
+  function X509SetNotBefore(x: PX509; tm: PASN1_UTCTIME): cInt;
+  function X509SetNotAfter(x: PX509; tm: PASN1_UTCTIME): cInt;
+  function X509GetSerialNumber(x: PX509): PASN1_cInt;
   function EvpPkeyNew: EVP_PKEY;
   procedure EvpPkeyFree(pk: EVP_PKEY);
-  function EvpPkeyAssign(pkey: EVP_PKEY; _type: integer; key: Prsa): integer;
+  function EvpPkeyAssign(pkey: EVP_PKEY; _type: cInt; key: Prsa): cInt;
   function EvpGetDigestByName(Name: String): PEVP_MD;
   procedure EVPcleanup;
-//  function ErrErrorString(e: integer; buf: PChar): PChar;
-  function SSLeayversion(t: integer): string;
-  procedure ErrErrorString(e: integer; var buf: string; len: integer);
-  function ErrGetError: integer;
+//  function ErrErrorString(e: cInt; buf: PChar): PChar;
+  function SSLeayversion(t: cInt): string;
+  procedure ErrErrorString(e: cInt; var buf: string; len: cInt);
+  function ErrGetError: cInt;
   procedure ErrClearError;
   procedure ErrFreeStrings;
-  procedure ErrRemoveState(pid: integer);
+  procedure ErrRemoveState(pid: cInt);
   procedure OPENSSLaddallalgorithms;
   procedure CRYPTOcleanupAllExData;
   procedure RandScreen;
   function BioNew(b: PBIO_METHOD): PBIO;
   procedure BioFreeAll(b: PBIO);
   function BioSMem: PBIO_METHOD;
-  function BioCtrlPending(b: PBIO): integer;
-  function BioRead(b: PBIO; var Buf: String; Len: integer): integer;
-  function BioWrite(b: PBIO; Buf: String; Len: integer): integer;
+  function BioCtrlPending(b: PBIO): cInt;
+  function BioRead(b: PBIO; var Buf: String; Len: cInt): cInt;
+  function BioWrite(b: PBIO; Buf: String; Len: cInt): cInt;
   function d2iPKCS12bio(b:PBIO; Pkcs12: SslPtr): SslPtr;
-  function PKCS12parse(p12: SslPtr; pass: string; var pkey, cert, ca: SslPtr): integer;
+  function PKCS12parse(p12: SslPtr; pass: string; var pkey, cert, ca: SslPtr): cInt;
   procedure PKCS12free(p12: SslPtr);
-  function RsaGenerateKey(bits, e: integer; callback: PFunction; cb_arg: SslPtr): PRSA;
+  function RsaGenerateKey(bits, e: cInt; callback: PFunction; cb_arg: SslPtr): PRSA;
   function Asn1UtctimeNew: PASN1_UTCTIME;
   procedure Asn1UtctimeFree(a: PASN1_UTCTIME);
-  function Asn1IntegerSet(a: PASN1_INTEGER; v: integer): integer;
-  function i2dX509bio(b: PBIO; x: PX509): integer;
-  function i2dPrivateKeyBio(b: PBIO; pkey: EVP_PKEY): integer;
+  function Asn1cIntSet(a: PASN1_cInt; v: cInt): cInt;
+  function i2dX509bio(b: PBIO; x: PX509): cInt;
+  function i2dPrivateKeyBio(b: PBIO; pkey: EVP_PKEY): cInt;
 
   // 3DES functions
   procedure DESsetoddparity(Key: des_cblock);
-  function DESsetkeychecked(key: des_cblock; schedule: des_key_schedule): Integer;
-  procedure DESecbencrypt(Input: des_cblock; output: des_cblock; ks: des_key_schedule; enc: Integer);
+  function DESsetkeychecked(key: des_cblock; schedule: des_key_schedule): cInt;
+  procedure DESecbencrypt(Input: des_cblock; output: des_cblock; ks: des_key_schedule; enc: cInt);
 
 function IsSSLloaded: Boolean;
 function InitSSLInterface: Boolean;
@@ -293,100 +292,100 @@ implementation
 
 type
 // libssl.dll
-  TSslGetError = function(s: PSSL; ret_code: Integer):Integer; cdecl;
-  TSslLibraryInit = function:Integer; cdecl;
+  TSslGetError = function(s: PSSL; ret_code: cInt):cInt; cdecl;
+  TSslLibraryInit = function:cInt; cdecl;
   TSslLoadErrorStrings = procedure; cdecl;
-  TSslCtxSetCipherList = function(arg0: PSSL_CTX; str: PChar):Integer; cdecl;
+  TSslCtxSetCipherList = function(arg0: PSSL_CTX; str: PChar):cInt; cdecl;
   TSslCtxNew = function(meth: PSSL_METHOD):PSSL_CTX; cdecl;
   TSslCtxFree = procedure(arg0: PSSL_CTX); cdecl;
-  TSslSetFd = function(s: PSSL; fd: Integer):Integer; cdecl;
+  TSslSetFd = function(s: PSSL; fd: cInt):cInt; cdecl;
   TSslMethodV2 = function:PSSL_METHOD; cdecl;
   TSslMethodV3 = function:PSSL_METHOD; cdecl;
   TSslMethodTLSV1 = function:PSSL_METHOD; cdecl;
   TSslMethodV23 = function:PSSL_METHOD; cdecl;
-  TSslCtxUsePrivateKey = function(ctx: PSSL_CTX; pkey: sslptr):Integer; cdecl;
-  TSslCtxUsePrivateKeyASN1 = function(pk: integer; ctx: PSSL_CTX; d: sslptr; len: integer):Integer; cdecl;
-  TSslCtxUsePrivateKeyFile = function(ctx: PSSL_CTX; const _file: PChar; _type: Integer):Integer; cdecl;
-  TSslCtxUseCertificate = function(ctx: PSSL_CTX; x: SslPtr):Integer; cdecl;
-  TSslCtxUseCertificateASN1 = function(ctx: PSSL_CTX; len: Integer; d: SslPtr):Integer; cdecl;
-  TSslCtxUseCertificateFile = function(ctx: PSSL_CTX; const _file: PChar; _type: Integer):Integer; cdecl;
-  TSslCtxUseCertificateChainFile = function(ctx: PSSL_CTX; const _file: PChar):Integer; cdecl;
-  TSslCtxCheckPrivateKeyFile = function(ctx: PSSL_CTX):Integer; cdecl;
+  TSslCtxUsePrivateKey = function(ctx: PSSL_CTX; pkey: sslptr):cInt; cdecl;
+  TSslCtxUsePrivateKeyASN1 = function(pk: cInt; ctx: PSSL_CTX; d: sslptr; len: cInt):cInt; cdecl;
+  TSslCtxUsePrivateKeyFile = function(ctx: PSSL_CTX; const _file: PChar; _type: cInt):cInt; cdecl;
+  TSslCtxUseCertificate = function(ctx: PSSL_CTX; x: SslPtr):cInt; cdecl;
+  TSslCtxUseCertificateASN1 = function(ctx: PSSL_CTX; len: cInt; d: SslPtr):cInt; cdecl;
+  TSslCtxUseCertificateFile = function(ctx: PSSL_CTX; const _file: PChar; _type: cInt):cInt; cdecl;
+  TSslCtxUseCertificateChainFile = function(ctx: PSSL_CTX; const _file: PChar):cInt; cdecl;
+  TSslCtxCheckPrivateKeyFile = function(ctx: PSSL_CTX):cInt; cdecl;
   TSslCtxSetDefaultPasswdCb = procedure(ctx: PSSL_CTX; cb: SslPtr); cdecl;
   TSslCtxSetDefaultPasswdCbUserdata = procedure(ctx: PSSL_CTX; u: SslPtr); cdecl;
-  TSslCtxLoadVerifyLocations = function(ctx: PSSL_CTX; const CAfile: PChar; const CApath: PChar):Integer; cdecl;
+  TSslCtxLoadVerifyLocations = function(ctx: PSSL_CTX; const CAfile: PChar; const CApath: PChar):cInt; cdecl;
   TSslNew = function(ctx: PSSL_CTX):PSSL; cdecl;
   TSslFree = procedure(ssl: PSSL); cdecl;
-  TSslAccept = function(ssl: PSSL):Integer; cdecl;
-  TSslConnect = function(ssl: PSSL):Integer; cdecl;
-  TSslShutdown = function(ssl: PSSL):Integer; cdecl;
-  TSslRead = function(ssl: PSSL; buf: PChar; num: Integer):Integer; cdecl;
-  TSslPeek = function(ssl: PSSL; buf: PChar; num: Integer):Integer; cdecl;
-  TSslWrite = function(ssl: PSSL; const buf: PChar; num: Integer):Integer; cdecl;
-  TSslPending = function(ssl: PSSL):Integer; cdecl;
+  TSslAccept = function(ssl: PSSL):cInt; cdecl;
+  TSslConnect = function(ssl: PSSL):cInt; cdecl;
+  TSslShutdown = function(ssl: PSSL):cInt; cdecl;
+  TSslRead = function(ssl: PSSL; buf: PChar; num: cInt):cInt; cdecl;
+  TSslPeek = function(ssl: PSSL; buf: PChar; num: cInt):cInt; cdecl;
+  TSslWrite = function(ssl: PSSL; const buf: PChar; num: cInt):cInt; cdecl;
+  TSslPending = function(ssl: PSSL):cInt; cdecl;
   TSslGetVersion = function(ssl: PSSL):PChar; cdecl;
   TSslGetPeerCertificate = function(ssl: PSSL):PX509; cdecl;
-  TSslCtxSetVerify = procedure(ctx: PSSL_CTX; mode: Integer; arg2: SslPtr); cdecl;
+  TSslCtxSetVerify = procedure(ctx: PSSL_CTX; mode: cInt; arg2: SslPtr); cdecl;
   TSSLGetCurrentCipher = function(s: PSSL):SslPtr; cdecl;
   TSSLCipherGetName = function(c: Sslptr):PChar; cdecl;
-  TSSLCipherGetBits = function(c: SslPtr; alg_bits: PInteger):Integer; cdecl;
-  TSSLGetVerifyResult = function(ssl: PSSL):Integer; cdecl;
+  TSSLCipherGetBits = function(c: SslPtr; alg_bits: PcInt):cInt; cdecl;
+  TSSLGetVerifyResult = function(ssl: PSSL):cInt; cdecl;
 
 // libeay.dll
   TX509New = function: PX509; cdecl;
   TX509Free = procedure(x: PX509); cdecl;
-  TX509NameOneline = function(a: PX509_NAME; buf: PChar; size: Integer):PChar; cdecl;
+  TX509NameOneline = function(a: PX509_NAME; buf: PChar; size: cInt):PChar; cdecl;
   TX509GetSubjectName = function(a: PX509):PX509_NAME; cdecl;
   TX509GetIssuerName = function(a: PX509):PX509_NAME; cdecl;
-  TX509NameHash = function(x: PX509_NAME):Cardinal; cdecl;
-  TX509Digest = function(data: PX509; _type: PEVP_MD; md: PChar; len: PInteger):Integer; cdecl;
-  TX509print = function(b: PBIO; a: PX509): integer; cdecl;
-  TX509SetVersion = function(x: PX509; version: integer): integer; cdecl;
-  TX509SetPubkey = function(x: PX509; pkey: EVP_PKEY): integer; cdecl;
-  TX509SetIssuerName = function(x: PX509; name: PX509_NAME): integer; cdecl;
-  TX509NameAddEntryByTxt = function(name: PX509_NAME; field: PChar; _type: integer;
-    bytes: PChar; len, loc, _set: integer): integer; cdecl;
-  TX509Sign = function(x: PX509; pkey: EVP_PKEY; const md: PEVP_MD): integer; cdecl;
-  TX509GmtimeAdj = function(s: PASN1_UTCTIME; adj: integer): PASN1_UTCTIME; cdecl;
-  TX509SetNotBefore = function(x: PX509; tm: PASN1_UTCTIME): integer; cdecl;
-  TX509SetNotAfter = function(x: PX509; tm: PASN1_UTCTIME): integer; cdecl;
-  TX509GetSerialNumber = function(x: PX509): PASN1_INTEGER; cdecl;
+  TX509NameHash = function(x: PX509_NAME):cuLong; cdecl;
+  TX509Digest = function(data: PX509; _type: PEVP_MD; md: PChar; len: PcInt):cInt; cdecl;
+  TX509print = function(b: PBIO; a: PX509): cInt; cdecl;
+  TX509SetVersion = function(x: PX509; version: cInt): cInt; cdecl;
+  TX509SetPubkey = function(x: PX509; pkey: EVP_PKEY): cInt; cdecl;
+  TX509SetIssuerName = function(x: PX509; name: PX509_NAME): cInt; cdecl;
+  TX509NameAddEntryByTxt = function(name: PX509_NAME; field: PChar; _type: cInt;
+    bytes: PChar; len, loc, _set: cInt): cInt; cdecl;
+  TX509Sign = function(x: PX509; pkey: EVP_PKEY; const md: PEVP_MD): cInt; cdecl;
+  TX509GmtimeAdj = function(s: PASN1_UTCTIME; adj: cInt): PASN1_UTCTIME; cdecl;
+  TX509SetNotBefore = function(x: PX509; tm: PASN1_UTCTIME): cInt; cdecl;
+  TX509SetNotAfter = function(x: PX509; tm: PASN1_UTCTIME): cInt; cdecl;
+  TX509GetSerialNumber = function(x: PX509): PASN1_cInt; cdecl;
   TEvpPkeyNew = function: EVP_PKEY; cdecl;
   TEvpPkeyFree = procedure(pk: EVP_PKEY); cdecl;
-  TEvpPkeyAssign = function(pkey: EVP_PKEY; _type: integer; key: Prsa): integer; cdecl;
+  TEvpPkeyAssign = function(pkey: EVP_PKEY; _type: cInt; key: Prsa): cInt; cdecl;
   TEvpGetDigestByName = function(Name: PChar): PEVP_MD; cdecl;
   TEVPcleanup = procedure; cdecl;
-  TSSLeayversion = function(t: integer): PChar; cdecl;
-  TErrErrorString = procedure(e: integer; buf: PChar; len: integer); cdecl;
-  TErrGetError = function: integer; cdecl;
+  TSSLeayversion = function(t: cInt): PChar; cdecl;
+  TErrErrorString = procedure(e: cInt; buf: PChar; len: cInt); cdecl;
+  TErrGetError = function: cInt; cdecl;
   TErrClearError = procedure; cdecl;
   TErrFreeStrings = procedure; cdecl;
-  TErrRemoveState = procedure(pid: integer); cdecl;
+  TErrRemoveState = procedure(pid: cInt); cdecl;
   TOPENSSLaddallalgorithms = procedure; cdecl;
   TCRYPTOcleanupAllExData = procedure; cdecl;
   TRandScreen = procedure; cdecl;
   TBioNew = function(b: PBIO_METHOD): PBIO; cdecl;
   TBioFreeAll = procedure(b: PBIO); cdecl;
   TBioSMem = function: PBIO_METHOD; cdecl;
-  TBioCtrlPending = function(b: PBIO): integer; cdecl;
-  TBioRead = function(b: PBIO; Buf: PChar; Len: integer): integer; cdecl;
-  TBioWrite = function(b: PBIO; Buf: PChar; Len: integer): integer; cdecl;
+  TBioCtrlPending = function(b: PBIO): cInt; cdecl;
+  TBioRead = function(b: PBIO; Buf: PChar; Len: cInt): cInt; cdecl;
+  TBioWrite = function(b: PBIO; Buf: PChar; Len: cInt): cInt; cdecl;
   Td2iPKCS12bio = function(b:PBIO; Pkcs12: SslPtr): SslPtr; cdecl;
-  TPKCS12parse = function(p12: SslPtr; pass: PChar; var pkey, cert, ca: SslPtr): integer; cdecl;
+  TPKCS12parse = function(p12: SslPtr; pass: PChar; var pkey, cert, ca: SslPtr): cInt; cdecl;
   TPKCS12free = procedure(p12: SslPtr); cdecl;
-  TRsaGenerateKey = function(bits, e: integer; callback: PFunction; cb_arg: SslPtr): PRSA; cdecl;
+  TRsaGenerateKey = function(bits, e: cInt; callback: PFunction; cb_arg: SslPtr): PRSA; cdecl;
   TAsn1UtctimeNew = function: PASN1_UTCTIME; cdecl;
   TAsn1UtctimeFree = procedure(a: PASN1_UTCTIME); cdecl;
-  TAsn1IntegerSet = function(a: PASN1_INTEGER; v: integer): integer; cdecl;
-  Ti2dX509bio = function(b: PBIO; x: PX509): integer; cdecl;
-  Ti2dPrivateKeyBio= function(b: PBIO; pkey: EVP_PKEY): integer; cdecl;
+  TAsn1cIntSet = function(a: PASN1_cInt; v: cInt): cInt; cdecl;
+  Ti2dX509bio = function(b: PBIO; x: PX509): cInt; cdecl;
+  Ti2dPrivateKeyBio= function(b: PBIO; pkey: EVP_PKEY): cInt; cdecl;
 
   // 3DES functions
   TDESsetoddparity = procedure(Key: des_cblock); cdecl;
-  TDESsetkeychecked = function(key: des_cblock; schedule: des_key_schedule): Integer; cdecl;
-  TDESecbencrypt = procedure(Input: des_cblock; output: des_cblock; ks: des_key_schedule; enc: Integer); cdecl;
+  TDESsetkeychecked = function(key: des_cblock; schedule: des_key_schedule): cInt; cdecl;
+  TDESecbencrypt = procedure(Input: des_cblock; output: des_cblock; ks: des_key_schedule; enc: cInt); cdecl;
   //thread lock functions
-  TCRYPTOnumlocks = function: integer; cdecl;
+  TCRYPTOnumlocks = function: cInt; cdecl;
   TCRYPTOSetLockingCallback = procedure(cb: Sslptr); cdecl;
 
 var
@@ -474,7 +473,7 @@ var
   _RsaGenerateKey: TRsaGenerateKey = nil;
   _Asn1UtctimeNew: TAsn1UtctimeNew = nil;
   _Asn1UtctimeFree: TAsn1UtctimeFree = nil;
-  _Asn1IntegerSet: TAsn1IntegerSet = nil;
+  _Asn1cIntSet: TAsn1cIntSet = nil;
   _i2dX509bio: Ti2dX509bio = nil;
   _i2dPrivateKeyBio: Ti2dPrivateKeyBio = nil;
 
@@ -490,7 +489,7 @@ var
   SSLloaded: boolean = false;
 
 // libssl.dll
-function SslGetError(s: PSSL; ret_code: Integer):Integer;
+function SslGetError(s: PSSL; ret_code: cInt):cInt;
 begin
   if InitSSLInterface and Assigned(_SslGetError) then
     Result := _SslGetError(s, ret_code)
@@ -498,7 +497,7 @@ begin
     Result := SSL_ERROR_SSL;
 end;
 
-function SslLibraryInit:Integer;
+function SslLibraryInit:cInt;
 begin
   if InitSSLInterface and Assigned(_SslLibraryInit) then
     Result := _SslLibraryInit
@@ -512,7 +511,7 @@ begin
     _SslLoadErrorStrings;
 end;
 
-function SslCtxSetCipherList(arg0: PSSL_CTX; var str: String):Integer;
+function SslCtxSetCipherList(arg0: PSSL_CTX; var str: String):cInt;
 begin
   if InitSSLInterface and Assigned(_SslCtxSetCipherList) then
     Result := _SslCtxSetCipherList(arg0, PChar(str))
@@ -534,7 +533,7 @@ begin
     _SslCtxFree(arg0);
 end;
 
-function SslSetFd(s: PSSL; fd: Integer):Integer;
+function SslSetFd(s: PSSL; fd: cInt):cInt;
 begin
   if InitSSLInterface and Assigned(_SslSetFd) then
     Result := _SslSetFd(s, fd)
@@ -574,7 +573,7 @@ begin
     Result := nil;
 end;
 
-function SslCtxUsePrivateKey(ctx: PSSL_CTX; pkey: SslPtr):Integer;
+function SslCtxUsePrivateKey(ctx: PSSL_CTX; pkey: SslPtr):cInt;
 begin
   if InitSSLInterface and Assigned(_SslCtxUsePrivateKey) then
     Result := _SslCtxUsePrivateKey(ctx, pkey)
@@ -582,7 +581,7 @@ begin
     Result := 0;
 end;
 
-function SslCtxUsePrivateKeyASN1(pk: integer; ctx: PSSL_CTX; d: String; len: integer):Integer;
+function SslCtxUsePrivateKeyASN1(pk: cInt; ctx: PSSL_CTX; d: String; len: cLong):cInt;
 begin
   if InitSSLInterface and Assigned(_SslCtxUsePrivateKeyASN1) then
     Result := _SslCtxUsePrivateKeyASN1(pk, ctx, Sslptr(d), len)
@@ -590,7 +589,7 @@ begin
     Result := 0;
 end;
 
-function SslCtxUsePrivateKeyFile(ctx: PSSL_CTX; const _file: String; _type: Integer):Integer;
+function SslCtxUsePrivateKeyFile(ctx: PSSL_CTX; const _file: String; _type: cInt):cInt;
 begin
   if InitSSLInterface and Assigned(_SslCtxUsePrivateKeyFile) then
     Result := _SslCtxUsePrivateKeyFile(ctx, PChar(_file), _type)
@@ -598,7 +597,7 @@ begin
     Result := 0;
 end;
 
-function SslCtxUseCertificate(ctx: PSSL_CTX; x: SslPtr):Integer;
+function SslCtxUseCertificate(ctx: PSSL_CTX; x: SslPtr):cInt;
 begin
   if InitSSLInterface and Assigned(_SslCtxUseCertificate) then
     Result := _SslCtxUseCertificate(ctx, x)
@@ -606,7 +605,7 @@ begin
     Result := 0;
 end;
 
-function SslCtxUseCertificateASN1(ctx: PSSL_CTX; len: integer; d: String):Integer;
+function SslCtxUseCertificateASN1(ctx: PSSL_CTX; len: cLong; d: String):cInt;
 begin
   if InitSSLInterface and Assigned(_SslCtxUseCertificateASN1) then
     Result := _SslCtxUseCertificateASN1(ctx, len, SslPtr(d))
@@ -614,7 +613,7 @@ begin
     Result := 0;
 end;
 
-function SslCtxUseCertificateFile(ctx: PSSL_CTX; const _file: String; _type: Integer):Integer;
+function SslCtxUseCertificateFile(ctx: PSSL_CTX; const _file: String; _type: cInt):cInt;
 begin
   if InitSSLInterface and Assigned(_SslCtxUseCertificateFile) then
     Result := _SslCtxUseCertificateFile(ctx, PChar(_file), _type)
@@ -622,7 +621,7 @@ begin
     Result := 0;
 end;
 
-function SslCtxUseCertificateChainFile(ctx: PSSL_CTX; const _file: String):Integer;
+function SslCtxUseCertificateChainFile(ctx: PSSL_CTX; const _file: String):cInt;
 begin
   if InitSSLInterface and Assigned(_SslCtxUseCertificateChainFile) then
     Result := _SslCtxUseCertificateChainFile(ctx, PChar(_file))
@@ -630,7 +629,7 @@ begin
     Result := 0;
 end;
 
-function SslCtxCheckPrivateKeyFile(ctx: PSSL_CTX):Integer;
+function SslCtxCheckPrivateKeyFile(ctx: PSSL_CTX):cInt;
 begin
   if InitSSLInterface and Assigned(_SslCtxCheckPrivateKeyFile) then
     Result := _SslCtxCheckPrivateKeyFile(ctx)
@@ -650,7 +649,7 @@ begin
     _SslCtxSetDefaultPasswdCbUserdata(ctx, u);
 end;
 
-function SslCtxLoadVerifyLocations(ctx: PSSL_CTX; const CAfile: String; const CApath: String):Integer;
+function SslCtxLoadVerifyLocations(ctx: PSSL_CTX; const CAfile: String; const CApath: String):cInt;
 begin
   if InitSSLInterface and Assigned(_SslCtxLoadVerifyLocations) then
     Result := _SslCtxLoadVerifyLocations(ctx, SslPtr(CAfile), SslPtr(CApath))
@@ -672,7 +671,7 @@ begin
     _SslFree(ssl);
 end;
 
-function SslAccept(ssl: PSSL):Integer;
+function SslAccept(ssl: PSSL):cInt;
 begin
   if InitSSLInterface and Assigned(_SslAccept) then
     Result := _SslAccept(ssl)
@@ -680,7 +679,7 @@ begin
     Result := -1;
 end;
 
-function SslConnect(ssl: PSSL):Integer;
+function SslConnect(ssl: PSSL):cInt;
 begin
   if InitSSLInterface and Assigned(_SslConnect) then
     Result := _SslConnect(ssl)
@@ -688,7 +687,7 @@ begin
     Result := -1;
 end;
 
-function SslShutdown(ssl: PSSL):Integer;
+function SslShutdown(ssl: PSSL):cInt;
 begin
   if InitSSLInterface and Assigned(_SslShutdown) then
     Result := _SslShutdown(ssl)
@@ -696,7 +695,7 @@ begin
     Result := -1;
 end;
 
-function SslRead(ssl: PSSL; buf: SslPtr; num: Integer):Integer;
+function SslRead(ssl: PSSL; buf: SslPtr; num: cInt):cInt;
 begin
   if InitSSLInterface and Assigned(_SslRead) then
     Result := _SslRead(ssl, PChar(buf), num)
@@ -704,7 +703,7 @@ begin
     Result := -1;
 end;
 
-function SslPeek(ssl: PSSL; buf: SslPtr; num: Integer):Integer;
+function SslPeek(ssl: PSSL; buf: SslPtr; num: cInt):cInt;
 begin
   if InitSSLInterface and Assigned(_SslPeek) then
     Result := _SslPeek(ssl, PChar(buf), num)
@@ -712,7 +711,7 @@ begin
     Result := -1;
 end;
 
-function SslWrite(ssl: PSSL; buf: SslPtr; num: Integer):Integer;
+function SslWrite(ssl: PSSL; buf: SslPtr; num: cInt):cInt;
 begin
   if InitSSLInterface and Assigned(_SslWrite) then
     Result := _SslWrite(ssl, PChar(buf), num)
@@ -720,7 +719,7 @@ begin
     Result := -1;
 end;
 
-function SslPending(ssl: PSSL):Integer;
+function SslPending(ssl: PSSL):cInt;
 begin
   if InitSSLInterface and Assigned(_SslPending) then
     Result := _SslPending(ssl)
@@ -745,7 +744,7 @@ begin
     Result := nil;
 end;
 
-procedure SslCtxSetVerify(ctx: PSSL_CTX; mode: Integer; arg2: PFunction);
+procedure SslCtxSetVerify(ctx: PSSL_CTX; mode: cInt; arg2: PFunction);
 begin
   if InitSSLInterface and Assigned(_SslCtxSetVerify) then
     _SslCtxSetVerify(ctx, mode, @arg2);
@@ -770,7 +769,7 @@ begin
     Result := '';
 end;
 
-function SSLCipherGetBits(c: SslPtr; var alg_bits: Integer):Integer;
+function SSLCipherGetBits(c: SslPtr; var alg_bits: cInt):cInt;
 begin
   if InitSSLInterface and Assigned(_SSLCipherGetBits) then
     Result := _SSLCipherGetBits(c, @alg_bits)
@@ -778,7 +777,7 @@ begin
     Result := 0;
 end;
 
-function SSLGetVerifyResult(ssl: PSSL):Integer;
+function SSLGetVerifyResult(ssl: PSSL):cLong;
 begin
   if InitSSLInterface and Assigned(_SSLGetVerifyResult) then
     Result := _SSLGetVerifyResult(ssl)
@@ -801,7 +800,7 @@ begin
     _X509Free(x);
 end;
 
-function X509NameOneline(a: PX509_NAME; var buf: String; size: Integer):String;
+function X509NameOneline(a: PX509_NAME; var buf: String; size: cInt):String;
 begin
   if InitSSLInterface and Assigned(_X509NameOneline) then
     Result := _X509NameOneline(a, PChar(buf),size)
@@ -825,7 +824,7 @@ begin
     Result := nil;
 end;
 
-function X509NameHash(x: PX509_NAME):Cardinal;
+function X509NameHash(x: PX509_NAME):cuLong;
 begin
   if InitSSLInterface and Assigned(_X509NameHash) then
     Result := _X509NameHash(x)
@@ -833,7 +832,7 @@ begin
     Result := 0;
 end;
 
-function X509Digest(data: PX509; _type: PEVP_MD; md: String; var len: Integer):Integer;
+function X509Digest(data: PX509; _type: PEVP_MD; md: String; var len: cInt):cInt;
 begin
   if InitSSLInterface and Assigned(_X509Digest) then
     Result := _X509Digest(data, _type, PChar(md), @len)
@@ -855,7 +854,7 @@ begin
     _EvpPkeyFree(pk);
 end;
 
-function SSLeayversion(t: integer): string;
+function SSLeayversion(t: cInt): string;
 begin
   if InitSSLInterface and Assigned(_SSLeayversion) then
     Result := PChar(_SSLeayversion(t))
@@ -863,14 +862,14 @@ begin
     Result := '';
 end;
 
-procedure ErrErrorString(e: integer; var buf: string; len: integer);
+procedure ErrErrorString(e: cInt; var buf: string; len: cInt);
 begin
   if InitSSLInterface and Assigned(_ErrErrorString) then
     _ErrErrorString(e, Pointer(buf), len);
   buf := PChar(Buf);
 end;
 
-function ErrGetError: integer;
+function ErrGetError: cInt;
 begin
   if InitSSLInterface and Assigned(_ErrGetError) then
     Result := _ErrGetError
@@ -890,7 +889,7 @@ begin
     _ErrFreeStrings;
 end;
 
-procedure ErrRemoveState(pid: integer);
+procedure ErrRemoveState(pid: cInt);
 begin
   if InitSSLInterface and Assigned(_ErrRemoveState) then
     _ErrRemoveState(pid);
@@ -942,7 +941,7 @@ begin
     Result := nil;
 end;
 
-function BioCtrlPending(b: PBIO): integer;
+function BioCtrlPending(b: PBIO): cInt;
 begin
   if InitSSLInterface and Assigned(_BioCtrlPending) then
     Result := _BioCtrlPending(b)
@@ -950,7 +949,7 @@ begin
     Result := 0;
 end;
 
-function BioRead(b: PBIO; var Buf: String; Len: integer): integer;
+function BioRead(b: PBIO; var Buf: String; Len: cInt): cInt;
 begin
   if InitSSLInterface and Assigned(_BioRead) then
     Result := _BioRead(b, PChar(Buf), Len)
@@ -958,8 +957,8 @@ begin
     Result := -2;
 end;
 
-//function BioWrite(b: PBIO; Buf: PChar; Len: integer): integer;
-function BioWrite(b: PBIO; Buf: String; Len: integer): integer;
+//function BioWrite(b: PBIO; Buf: PChar; Len: cInt): cInt;
+function BioWrite(b: PBIO; Buf: String; Len: cInt): cInt;
 begin
   if InitSSLInterface and Assigned(_BioWrite) then
     Result := _BioWrite(b, PChar(Buf), Len)
@@ -967,7 +966,7 @@ begin
     Result := -2;
 end;
 
-function X509print(b: PBIO; a: PX509): integer;
+function X509print(b: PBIO; a: PX509): cInt;
 begin
   if InitSSLInterface and Assigned(_X509print) then
     Result := _X509print(b, a)
@@ -983,7 +982,7 @@ begin
     Result := nil;
 end;
 
-function PKCS12parse(p12: SslPtr; pass: string; var pkey, cert, ca: SslPtr): integer;
+function PKCS12parse(p12: SslPtr; pass: string; var pkey, cert, ca: SslPtr): cInt;
 begin
   if InitSSLInterface and Assigned(_PKCS12parse) then
     Result := _PKCS12parse(p12, SslPtr(pass), pkey, cert, ca)
@@ -997,7 +996,7 @@ begin
     _PKCS12free(p12);
 end;
 
-function RsaGenerateKey(bits, e: integer; callback: PFunction; cb_arg: SslPtr): PRSA;
+function RsaGenerateKey(bits, e: cInt; callback: PFunction; cb_arg: SslPtr): PRSA;
 begin
   if InitSSLInterface and Assigned(_RsaGenerateKey) then
     Result := _RsaGenerateKey(bits, e, callback, cb_arg)
@@ -1005,7 +1004,7 @@ begin
     Result := nil;
 end;
 
-function EvpPkeyAssign(pkey: EVP_PKEY; _type: integer; key: Prsa): integer;
+function EvpPkeyAssign(pkey: EVP_PKEY; _type: cInt; key: Prsa): cInt;
 begin
   if InitSSLInterface and Assigned(_EvpPkeyAssign) then
     Result := _EvpPkeyAssign(pkey, _type, key)
@@ -1013,7 +1012,7 @@ begin
     Result := 0;
 end;
 
-function X509SetVersion(x: PX509; version: integer): integer;
+function X509SetVersion(x: PX509; version: cInt): cInt;
 begin
   if InitSSLInterface and Assigned(_X509SetVersion) then
     Result := _X509SetVersion(x, version)
@@ -1021,7 +1020,7 @@ begin
     Result := 0;
 end;
 
-function X509SetPubkey(x: PX509; pkey: EVP_PKEY): integer;
+function X509SetPubkey(x: PX509; pkey: EVP_PKEY): cInt;
 begin
   if InitSSLInterface and Assigned(_X509SetPubkey) then
     Result := _X509SetPubkey(x, pkey)
@@ -1029,7 +1028,7 @@ begin
     Result := 0;
 end;
 
-function X509SetIssuerName(x: PX509; name: PX509_NAME): integer;
+function X509SetIssuerName(x: PX509; name: PX509_NAME): cInt;
 begin
   if InitSSLInterface and Assigned(_X509SetIssuerName) then
     Result := _X509SetIssuerName(x, name)
@@ -1037,8 +1036,8 @@ begin
     Result := 0;
 end;
 
-function X509NameAddEntryByTxt(name: PX509_NAME; field: string; _type: integer;
-  bytes: string; len, loc, _set: integer): integer;
+function X509NameAddEntryByTxt(name: PX509_NAME; field: string; _type: cInt;
+  bytes: string; len, loc, _set: cInt): cInt;
 begin
   if InitSSLInterface and Assigned(_X509NameAddEntryByTxt) then
     Result := _X509NameAddEntryByTxt(name, PChar(field), _type, PChar(Bytes), len, loc, _set)
@@ -1046,7 +1045,7 @@ begin
     Result := 0;
 end;
 
-function X509Sign(x: PX509; pkey: EVP_PKEY; const md: PEVP_MD): integer;
+function X509Sign(x: PX509; pkey: EVP_PKEY; const md: PEVP_MD): cInt;
 begin
   if InitSSLInterface and Assigned(_X509Sign) then
     Result := _X509Sign(x, pkey, md)
@@ -1068,7 +1067,7 @@ begin
     _Asn1UtctimeFree(a);
 end;
 
-function X509GmtimeAdj(s: PASN1_UTCTIME; adj: integer): PASN1_UTCTIME;
+function X509GmtimeAdj(s: PASN1_UTCTIME; adj: cInt): PASN1_UTCTIME;
 begin
   if InitSSLInterface and Assigned(_X509GmtimeAdj) then
     Result := _X509GmtimeAdj(s, adj)
@@ -1076,7 +1075,7 @@ begin
     Result := nil;
 end;
 
-function X509SetNotBefore(x: PX509; tm: PASN1_UTCTIME): integer;
+function X509SetNotBefore(x: PX509; tm: PASN1_UTCTIME): cInt;
 begin
   if InitSSLInterface and Assigned(_X509SetNotBefore) then
     Result := _X509SetNotBefore(x, tm)
@@ -1084,7 +1083,7 @@ begin
     Result := 0;
 end;
 
-function X509SetNotAfter(x: PX509; tm: PASN1_UTCTIME): integer;
+function X509SetNotAfter(x: PX509; tm: PASN1_UTCTIME): cInt;
 begin
   if InitSSLInterface and Assigned(_X509SetNotAfter) then
     Result := _X509SetNotAfter(x, tm)
@@ -1092,7 +1091,7 @@ begin
     Result := 0;
 end;
 
-function i2dX509bio(b: PBIO; x: PX509): integer;
+function i2dX509bio(b: PBIO; x: PX509): cInt;
 begin
   if InitSSLInterface and Assigned(_i2dX509bio) then
     Result := _i2dX509bio(b, x)
@@ -1100,7 +1099,7 @@ begin
     Result := 0;
 end;
 
-function i2dPrivateKeyBio(b: PBIO; pkey: EVP_PKEY): integer;
+function i2dPrivateKeyBio(b: PBIO; pkey: EVP_PKEY): cInt;
 begin
   if InitSSLInterface and Assigned(_i2dPrivateKeyBio) then
     Result := _i2dPrivateKeyBio(b, pkey)
@@ -1116,15 +1115,15 @@ begin
     Result := nil;
 end;
 
-function Asn1IntegerSet(a: PASN1_INTEGER; v: integer): integer;
+function Asn1cIntSet(a: PASN1_cInt; v: cInt): cInt;
 begin
-  if InitSSLInterface and Assigned(_Asn1IntegerSet) then
-    Result := _Asn1IntegerSet(a, v)
+  if InitSSLInterface and Assigned(_Asn1cIntSet) then
+    Result := _Asn1cIntSet(a, v)
   else
     Result := 0;
 end;
 
-function X509GetSerialNumber(x: PX509): PASN1_INTEGER;
+function X509GetSerialNumber(x: PX509): PASN1_cInt;
 begin
   if InitSSLInterface and Assigned(_X509GetSerialNumber) then
     Result := _X509GetSerialNumber(x)
@@ -1139,7 +1138,7 @@ begin
     _DESsetoddparity(Key);
 end;
 
-function DESsetkeychecked(key: des_cblock; schedule: des_key_schedule): Integer;
+function DESsetkeychecked(key: des_cblock; schedule: des_key_schedule): cInt;
 begin
   if InitSSLInterface and Assigned(_DESsetkeychecked) then
     Result := _DESsetkeychecked(key, schedule)
@@ -1147,7 +1146,7 @@ begin
     Result := -1;
 end;
 
-procedure DESecbencrypt(Input: des_cblock; output: des_cblock; ks: des_key_schedule; enc: Integer);
+procedure DESecbencrypt(Input: des_cblock; output: des_cblock; ks: des_key_schedule; enc: cInt);
 begin
   if InitSSLInterface and Assigned(_DESecbencrypt) then
     _DESecbencrypt(Input, output, ks, enc);
@@ -1157,7 +1156,7 @@ end;
 { Try to load all library versions until you find or run out }
 function LoadLibHack(const Value: String): HModule;
 var
-  i: Integer;
+  i: cInt;
 begin
   Result := NilHandle;
   
@@ -1284,7 +1283,7 @@ begin
         _RsaGenerateKey := GetProcAddr(SSLUtilHandle, 'RSA_generate_key');
         _Asn1UtctimeNew := GetProcAddr(SSLUtilHandle, 'ASN1_UTCTIME_new');
         _Asn1UtctimeFree := GetProcAddr(SSLUtilHandle, 'ASN1_UTCTIME_free');
-        _Asn1IntegerSet := GetProcAddr(SSLUtilHandle, 'ASN1_INTEGER_set');
+        _Asn1cIntSet := GetProcAddr(SSLUtilHandle, 'ASN1_cInt_set');
         _i2dX509bio := GetProcAddr(SSLUtilHandle, 'i2d_X509_bio');
         _i2dPrivateKeyBio := GetProcAddr(SSLUtilHandle, 'i2d_PrivateKey_bio');
 
@@ -1433,7 +1432,7 @@ begin
     _RsaGenerateKey := nil;
     _Asn1UtctimeNew := nil;
     _Asn1UtctimeFree := nil;
-    _Asn1IntegerSet := nil;
+    _Asn1cIntSet := nil;
     _i2dX509bio := nil;
     _i2dPrivateKeyBio := nil;
 

packages/extra/sndfile/sndfile.pp

@@ -1,146 +1,628 @@
-unit sndfile;
+(*
+ - Translation for sndfile.h version 1.0.17 by Ido Kanner idokan at gmail dot com
+*)
+{
+** Copyright (C) 1999-2006 Erik de Castro Lopo <[email protected]>
+**
+** This program is free software; you can redistribute it and/or modify
+** it under the terms of the GNU Lesser General Public License as published by
+** the Free Software Foundation; either version 2.1 of the License, or
+** (at your option) any later version.
+**
+** This program is distributed in the hope that it will be useful,
+** but WITHOUT ANY WARRANTY; without even the implied warranty of
+** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+** GNU Lesser General Public License for more details.
+**
+** You should have received a copy of the GNU Lesser General Public License
+** along with this program; if not, write to the Free Software
+** Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+** sndfile.h -- system-wide definitions
+**
+** API documentation is in the doc/ directory of the source code tarball
+** and at http://www.mega-nerd.com/libsndfile/api.html.
+
+ This is the version 1.0.X header file.
+ 
+ For the Metrowerks CodeWarrior Pro Compiler (mainly MacOS)
+ 
+** The following file types can be read and written.
+** A file type would consist of a major type (ie SF_FORMAT_WAV) bitwise
+** ORed with a minor type (ie SF_FORMAT_PCM). SF_FORMAT_TYPEMASK and
+** SF_FORMAT_SUBMASK can be used to separate the major and minor file
+** types.
+}
+{$PACKRECORDS C}{$MACRO ON}
+unit sndfile; 
 
 interface
 
+uses
+  ctypes, unixtype;
+
+const
+  sndfilelib = 'sndfile';
+
+const
+  // Major formats.
+  SF_FORMAT_WAV   = $010000;		// Microsoft WAV format (little endian default).
+	SF_FORMAT_AIFF  = $020000;		// Apple/SGI AIFF format (big endian).
+	SF_FORMAT_AU    = $030000;		// Sun/NeXT AU format (big endian).
+	SF_FORMAT_RAW   = $040000;		// RAW PCM data.
+	SF_FORMAT_PAF   = $050000;		// Ensoniq PARIS file format.
+	SF_FORMAT_SVX   = $060000;		// Amiga IFF / SVX8 / SV16 format.
+	SF_FORMAT_NIST  = $070000;		// Sphere NIST format.
+	SF_FORMAT_VOC		= $080000;		// VOC files.
+	SF_FORMAT_IRCAM = $0A0000;		// Berkeley/IRCAM/CARL
+	SF_FORMAT_W64   = $0B0000;		// Sonic Foundry's 64 bit RIFF/WAV
+	SF_FORMAT_MAT4  = $0C0000;		// Matlab (tm) V4.2 / GNU Octave 2.0
+	SF_FORMAT_MAT5  = $0D0000;		// Matlab (tm) V5.0 / GNU Octave 2.1
+	SF_FORMAT_PVF   = $0E0000;		// Portable Voice Format
+	SF_FORMAT_XI    = $0F0000;		// Fasttracker 2 Extended Instrument
+	SF_FORMAT_HTK   = $100000;		// HMM Tool Kit format
+	SF_FORMAT_SDS   = $110000;		// Midi Sample Dump Standard
+	SF_FORMAT_AVR   = $120000;		// Audio Visual Research
+	SF_FORMAT_WAVEX = $130000;		// MS WAVE with WAVEFORMATEX
+	SF_FORMAT_SD2   = $160000;		// Sound Designer 2
+	SF_FORMAT_FLAC  = $170000;		// FLAC lossless file format
+	SF_FORMAT_CAF   = $180000;		// Core Audio File format
+ 
+const
+  //Subtypes from here on.
+  SF_FORMAT_PCM_S8    = $0001;    // Signed 8 bit data
+	SF_FORMAT_PCM_16    = $0002;    // Signed 16 bit data
+	SF_FORMAT_PCM_24    = $0003;    // Signed 24 bit data
+	SF_FORMAT_PCM_32    = $0004;    // Signed 32 bit data
+
+	SF_FORMAT_PCM_U8    = $0005;    // Unsigned 8 bit data (WAV and RAW only)
+
+	SF_FORMAT_FLOAT     = $0006;    // 32 bit float data
+	SF_FORMAT_DOUBLE    = $0007;    // 64 bit float data
+
+	SF_FORMAT_ULAW      = $0010;    // U-Law encoded.
+	SF_FORMAT_ALAW      = $0011;    // A-Law encoded.
+	SF_FORMAT_IMA_ADPCM = $0012;    // IMA ADPCM.
+	SF_FORMAT_MS_ADPCM  = $0013;    // Microsoft ADPCM.
+
+	SF_FORMAT_GSM610    = $0020;    // GSM 6.10 encoding.
+	SF_FORMAT_VOX_ADPCM = $0021;    // OKI / Dialogix ADPCM
+
+	SF_FORMAT_G721_32   = $0030;    // 32kbs G721 ADPCM encoding.
+	SF_FORMAT_G723_24   = $0031;    // 24kbs G723 ADPCM encoding.
+	SF_FORMAT_G723_40   = $0032;    // 40kbs G723 ADPCM encoding.
+
+	SF_FORMAT_DWVW_12   = $0040;    // 12 bit Delta Width Variable Word encoding.
+	SF_FORMAT_DWVW_16   = $0041;    // 16 bit Delta Width Variable Word encoding.
+	SF_FORMAT_DWVW_24   = $0042;    // 24 bit Delta Width Variable Word encoding.
+	SF_FORMAT_DWVW_N    = $0043;    // N bit Delta Width Variable Word encoding.
+
+	SF_FORMAT_DPCM_8    = $0050;    // 8 bit differential PCM (XI only)
+	SF_FORMAT_DPCM_16   = $0051;    // 16 bit differential PCM (XI only)
+
+const
+  // Endian-ness options.
+	SF_ENDIAN_FILE     = $00000000;  // Default file endian-ness.
+	SF_ENDIAN_LITTLE   = $10000000;  // Force little endian-ness.
+	SF_ENDIAN_BIG      = $20000000;  // Force big endian-ness.
+	SF_ENDIAN_CPU      = $30000000;  // Force CPU endian-ness.
+
+	SF_FORMAT_SUBMASK  = $0000FFFF;
+	SF_FORMAT_TYPEMASK = $0FFF0000;
+	SF_FORMAT_ENDMASK  = $30000000;
+
 {
-  Automatically converted by H2Pas 0.99.15 from sndfile.h
-  The following command line parameters were used:
-    -D
-    -p
-    -e
-    sndfile.h
-}
-
-  const
-    External_library='sndfile'; {Setup as you need}
+** The following are the valid command numbers for the sf_command()
+** interface.  The use of these commands is documented in the file
+** command.html in the doc directory of the source code distribution.
+}
+const
+  SFC_GET_LIB_VERSION            = $1000;
+	SFC_GET_LOG_INFO               = $1001;
 
-  { Pointers to basic pascal types, inserted by h2pas conversion program.}
-  Type
-    PLongint  = ^Longint;
-    PSmallInt = ^SmallInt;
-    PByte     = ^Byte;
-    PWord     = ^Word;
-    PDWord    = ^DWord;
-    PDouble   = ^Double;
+	SFC_GET_NORM_DOUBLE            = $1010;
+	SFC_GET_NORM_FLOAT             = $1011;
+	SFC_SET_NORM_DOUBLE            = $1012;
+	SFC_SET_NORM_FLOAT             = $1013;
+	SFC_SET_SCALE_FLOAT_INT_READ   = $1014;
 
-    size_t = Longint;
+	SFC_GET_SIMPLE_FORMAT_COUNT    = $1020;
+	SFC_GET_SIMPLE_FORMAT          = $1021;
 
-{$PACKRECORDS C}
+	SFC_GET_FORMAT_INFO            = $1028;
 
-     Const
-       SF_FORMAT_WAV = $10000;
-       SF_FORMAT_AIFF = $20000;
-       SF_FORMAT_AU = $30000;
-       SF_FORMAT_AULE = $40000;
-       SF_FORMAT_RAW = $50000;
-       SF_FORMAT_PAF = $60000;
-       SF_FORMAT_SVX = $70000;
-       SF_FORMAT_NIST = $80000;
-       SF_FORMAT_WMA = $90000;
-       SF_FORMAT_SMPLTD = $A0000;
-       SF_FORMAT_VOC = $B0000;
-       SF_FORMAT_SD2 = $C0000;
-       SF_FORMAT_REX2 = $D0000;
-       SF_FORMAT_IRCAM = $E0000;
-       SF_FORMAT_PCM = $0001;
-       SF_FORMAT_FLOAT = $0002;
-       SF_FORMAT_ULAW = $0003;
-       SF_FORMAT_ALAW = $0004;
-       SF_FORMAT_IMA_ADPCM = $0005;
-       SF_FORMAT_MS_ADPCM = $0006;
-       SF_FORMAT_PCM_BE = $0007;
-       SF_FORMAT_PCM_LE = $0008;
-       SF_FORMAT_PCM_S8 = $0009;
-       SF_FORMAT_PCM_U8 = $000A;
-       SF_FORMAT_SVX_FIB = $000B;
-       SF_FORMAT_SVX_EXP = $000C;
-       SF_FORMAT_GSM610 = $000D;
-       SF_FORMAT_G721_32 = $000E;
-       SF_FORMAT_G723_24 = $000F;
-       SF_FORMAT_FLOAT_BE = $0010;
-       SF_FORMAT_FLOAT_LE = $0011;
-       SF_FORMAT_SUBMASK = $FFFF;
-       SF_FORMAT_TYPEMASK = $7FFF0000;
+	SFC_GET_FORMAT_MAJOR_COUNT     = $1030;
+	SFC_GET_FORMAT_MAJOR           = $1031;
+	SFC_GET_FORMAT_SUBTYPE_COUNT   = $1032;
+	SFC_GET_FORMAT_SUBTYPE         = $1033;
 
-     SF_FORMAT_RAW_BE = SF_FORMAT_PCM_BE;
-     SF_FORMAT_RAW_LE = SF_FORMAT_PCM_LE;
-     SF_FORMAT_RAW_S8 = SF_FORMAT_PCM_S8;
-     SF_FORMAT_RAW_U8 = SF_FORMAT_PCM_U8;
+	SFC_CALC_SIGNAL_MAX            = $1040;
+	SFC_CALC_NORM_SIGNAL_MAX       = $1041;
+	SFC_CALC_MAX_ALL_CHANNELS      = $1042;
+	SFC_CALC_NORM_MAX_ALL_CHANNELS = $1043;
+	SFC_GET_SIGNAL_MAX             = $1044;
+	SFC_GET_MAX_ALL_CHANNELS       = $1045;
 
-  type
+	SFC_SET_ADD_PEAK_CHUNK         = $1050;
 
-     PSNDFILE = Pointer;
+	SFC_UPDATE_HEADER_NOW          = $1060;
+	SFC_SET_UPDATE_HEADER_AUTO     = $1061;
 
-     PSF_INFO = ^SF_INFO;
-     SF_INFO = record
-          samplerate : dword;
-          samples : dword;
-          channels : dword;
-          pcmbitwidth : dword;
-          format : dword;
-          sections : dword;
-          seekable : dword;
-       end;
-  function sf_open_read(path:Pchar; sfinfo:PSF_INFO):PSNDFILE;cdecl;external External_library name 'sf_open_read';
-  function sf_open_write(path:Pchar; sfinfo:PSF_INFO):PSNDFILE;cdecl;external External_library name 'sf_open_write';
+	SFC_FILE_TRUNCATE	             = $1080;
 
-  function sf_perror(sndfile:PSNDFILE):longint;cdecl;external External_library name 'sf_perror';
+	SFC_SET_RAW_START_OFFSET       = $1090;
 
-  function sf_error_str(sndfile:PSNDFILE; str:Pchar; len:size_t):longint;cdecl;external External_library name 'sf_error_str';
+	SFC_SET_DITHER_ON_WRITE        = $10A0;
+	SFC_SET_DITHER_ON_READ         = $10A1;
 
-  function sf_error_number(errnum:longint; str:Pchar; maxlen:size_t):longint;cdecl;external External_library name 'sf_error_number';
+	SFC_GET_DITHER_INFO_COUNT      = $10A2;
+	SFC_GET_DITHER_INFO            = $10A3;
 
-  function sf_get_header_info(sndfile:PSNDFILE; buffer:Pchar; bufferlen:size_t; offset:size_t):size_t;cdecl;external External_library name 'sf_get_header_info';
+	SFC_GET_EMBED_FILE_INFO        = $10B0;
 
-  function sf_get_lib_version(buffer:Pchar; bufferlen:size_t):size_t;cdecl;external External_library name 'sf_get_lib_version';
+	SFC_SET_CLIPPING               = $10C0;
+	SFC_GET_CLIPPING               = $10C1;
 
-  function sf_command(sndfile:PSNDFILE; cmd:Pchar; data:pointer; datasize:longint):longint;cdecl;external External_library name 'sf_command';
+	SFC_GET_INSTRUMENT             = $10D0;
+	SFC_SET_INSTRUMENT             = $10D1;
 
-  function sf_format_check(info:PSF_INFO):longint;cdecl;external External_library name 'sf_format_check';
+	SFC_GET_LOOP_INFO              = $10E0;
 
-  function sf_signal_max(sndfile:PSNDFILE):double;cdecl;external External_library name 'sf_signal_max';
+	SFC_GET_BROADCAST_INFO         = $10F0;
+	SFC_SET_BROADCAST_INFO         = $10F1;
 
-  function sf_seek(sndfile:PSNDFILE; frames:longint; whence:longint):longint;cdecl;external External_library name 'sf_seek';
+	// Following commands for testing only.
+	SFC_TEST_IEEE_FLOAT_REPLACE	   = $6001;
 
-  function sf_read_raw(sndfile:PSNDFILE; ptr:pointer; bytes:size_t):size_t;cdecl;external External_library name 'sf_read_raw';
+  {
+	** SFC_SET_ADD_* values are deprecated and will disappear at some
+	** time in the future. They are guaranteed to be here up to and
+	** including version 1.0.8 to avoid breakage of existng software.
+	** They currently do nothing and will continue to do nothing.
+  }
+	SFC_SET_ADD_DITHER_ON_WRITE	   = $1070;
+	SFC_SET_ADD_DITHER_ON_READ     = $1071;
 
-  function sf_write_raw(sndfile:PSNDFILE; ptr:pointer; bytes:size_t):size_t;cdecl;external External_library name 'sf_write_raw';
+{
+** String types that can be set and read from files. Not all file types
+** support this and even the file types which support one, may not support
+** all string types.
+}
+const
+  SF_STR_TITLE     = $01;
+	SF_STR_COPYRIGHT = $02;
+	SF_STR_SOFTWARE  = $03;
+	SF_STR_ARTIST    = $04;
+	SF_STR_COMMENT   = $05;
+	SF_STR_DATE      = $06;
+ 
+{
+** Use the following as the start and end index when doing metadata
+** transcoding.
+}
+  SF_STR_FIRST     = SF_STR_TITLE;
+  SF_STR_LAST      = SF_STR_DATE;
 
-  function sf_readf_short(sndfile:PSNDFILE; ptr:Psmallint; frames:size_t):size_t;cdecl;external External_library name 'sf_readf_short';
+const
+  // True and false
+  SF_FALSE = 0;
+  SF_TRUE  = 1;
 
-  function sf_writef_short(sndfile:PSNDFILE; ptr:Psmallint; frames:size_t):size_t;cdecl;external External_library name 'sf_writef_short';
+const
+  // Modes for opening files.
+  SFM_READ  = $10;
+	SFM_WRITE = $20;
+	SFM_RDWR  = $30;
 
-  function sf_readf_int(sndfile:PSNDFILE; ptr:Plongint; frames:size_t):size_t;cdecl;external External_library name 'sf_readf_int';
+{
+** Public error values. These are guaranteed to remain unchanged for the duration
+** of the library major version number.
+** There are also a large number of private error numbers which are internal to
+** the library which can change at any time.
+}
+const
+  SF_ERR_NO_ERROR             = 0;
+	SF_ERR_UNRECOGNISED_FORMAT  = 1;
+	SF_ERR_SYSTEM               = 2;
+	SF_ERR_MALFORMED_FILE       = 3;
+	SF_ERR_UNSUPPORTED_ENCODING = 4;
 
-  function sf_writef_int(sndfile:PSNDFILE; ptr:Plongint; frames:size_t):size_t;cdecl;external External_library name 'sf_writef_int';
+//A SNDFILE* pointer can be passed around much like stdio.h's FILE* pointer.
 
-  function sf_readf_float(sndfile:PSNDFILE; ptr:Pdouble; frames:size_t):size_t;cdecl;external External_library name 'sf_readf_float';
+type
+  PSNDFILE     = pointer;
+  PSNDFILE_tag = PSNDFILE;
 
-  function sf_writef_float(sndfile:PSNDFILE; ptr:Pdouble; frames:size_t):size_t;cdecl;external External_library name 'sf_writef_float';
+{
+** The following typedef is system specific and is defined when libsndfile is.
+** compiled. sf_count_t can be one of loff_t (Linux), off_t (*BSD),
+** off64_t (Solaris), __int64_t (Win32) etc.
+}
+type
+  Psf_count_t  = ^Tsf_count_t;
+  Tsf_count_t = off_t;
 
-  function sf_readf_double(sndfile:PSNDFILE; ptr:Pdouble; frames:size_t; normalize:longint):size_t;cdecl;external External_library name 'sf_readf_double';
+const
+  SF_COUNT_MAX = ctypes.clong($7FFFFFFFFFFFFFFF);
 
-  function sf_writef_double(sndfile:PSNDFILE; ptr:Pdouble; frames:size_t; normalize:longint):size_t;cdecl;external External_library name 'sf_writef_double';
+{
+** A pointer to a SF_INFO structure is passed to sf_open_read () and filled in.
+** On write, the SF_INFO structure is filled in by the user and passed into
+** sf_open_write ().
+}
+type
+  PSF_INFO = ^TSF_INFO;
+  TSF_INFO = record
+               frames     : Tsf_count_t; // Used to be called samples.  Changed to avoid confusion.
+               samplerate : ctypes.cint;
+               format     : ctypes.cint;
+               sections   : ctypes.cint;
+               seekable   : ctypes.cint;
+             end;
 
-  function sf_read_short(sndfile:PSNDFILE; ptr:Psmallint; items:size_t):size_t;cdecl;external External_library name 'sf_read_short';
+{
+** The SF_FORMAT_INFO struct is used to retrieve information about the sound
+** file formats libsndfile supports using the sf_command () interface.
+**
+** Using this interface will allow applications to support new file formats
+** and encoding types when libsndfile is upgraded, without requiring
+** re-compilation of the application.
+**
+** Please consult the libsndfile documentation (particularly the information
+** on the sf_command () interface) for examples of its use.
+}
+type
+  PSF_FORMAT_INFO = ^TSF_FORMAT_INFO;
+  TSF_FORMAT_INFO = record
+                      format    : ctypes.cint;
+                      name      : ctypes.pcchar;
+                      extention : ctypes.pcchar;
+                    end;
 
-  function sf_write_short(sndfile:PSNDFILE; ptr:Psmallint; items:size_t):size_t;cdecl;external External_library name 'sf_write_short';
+{
+** Enums and typedefs for adding dither on read and write.
+** See the html documentation for sf_command(), SFC_SET_DITHER_ON_WRITE
+** and SFC_SET_DITHER_ON_READ.
+}
+const
+  SFD_DEFAULT_LEVEL	 = 0;
+	SFD_CUSTOM_LEVEL	 = $40000000;
+
+	SFD_NO_DITHER      = 500;
+	SFD_WHITE          = 501;
+	SFD_TRIANGULAR_PDF = 502;
+
+type
+  PSF_DITHER_INFO = ^TSF_DITHER_INFO;
+  TSF_DITHER_INFO = record
+                      type_ : ctypes.cint;
+                      level : ctypes.cdouble;
+                      name  : ctypes.pcchar;
+                    end;
 
-  function sf_read_int(sndfile:PSNDFILE; ptr:Plongint; items:size_t):size_t;cdecl;external External_library name 'sf_read_int';
+{
+** Struct used to retrieve information about a file embedded within a
+** larger file. See SFC_GET_EMBED_FILE_INFO.
+}
+type
+  PSF_EMBED_FILE_INFO = ^TSF_EMBED_FILE_INFO;
+  TSF_EMBED_FILE_INFO = record
+                          offset : Tsf_count_t;
+                          length : Tsf_count_t;
+                        end;
+
+// Structs used to retrieve music sample information from a file.
+
+const
+// The loop mode field in SF_INSTRUMENT will be one of the following.
+  SF_LOOP_NONE        = 800;
+  SF_LOOP_FORWARD     = 801;
+  SF_LOOP_BACKWARD    = 802;
+  SF_LOOP_ALTERNATING = 803;
+  
+type
+  PSF_INSTRUMENT = ^TSF_INSTRUMENT;
+  TSF_INSTRUMENT = record
+                     gain         : ctypes.cint;
+                     basenote,
+                     detune       : ctypes.cchar;
+                     velocity_lo,
+                     velocity_hi  : ctypes.cchar;
+                     loop_count   : ctypes.cint;
+                     loops        : array[0..15] of record
+                                                      mode  : ctypes.cint;
+                                                      start : ctypes.cuint;
+                                                      end_  : ctypes.cuint;
+                                                      count : ctypes.cuint;
+                                                    end;
+                   end;
+
+// Struct used to retrieve loop information from a file.
+type
+  PSF_LOOP_INFO = ^TSF_LOOP_INFO;
+  TSF_LOOP_INFO = record
+                    time_sig_num : ctypes.cushort;             // any positive integer    > 0
+                    time_sig_den : ctypes.cushort;             // any positive power of 2 > 0
+                    loop_mode    : ctypes.cint;                // see SF_LOOP enum
+                    
+                    num_beats    : ctypes.cint;                // this is NOT the amount of quarter notes !!!
+                                                               // a full bar of 4/4 is 4 beats
+                                                               // a full bar of 7/8 is 7 beats
+                                                   
+                    bpm          : ctypes.cfloat;              // suggestion, as it can be calculated using other fields:
+                                                               // file's lenght, file's sampleRate and our time_sig_den
+                                                               // -> bpms are always the amount of _quarter notes_ per minute
+                                                   
+                    root_key     : ctypes.cint;                // MIDI note, or -1 for None
+                    future       : array[0..5] of ctypes.cint;
+                  end;
+                  
 
-  function sf_write_int(sndfile:PSNDFILE; ptr:Plongint; items:size_t):size_t;cdecl;external External_library name 'sf_write_int';
+{
+**	Struct used to retrieve broadcast (EBU) information from a file.
+**	Strongly (!) based on EBU "bext" chunk format used in Broadcast WAVE.
+}
+type
+  PSF_BROADCAST_INFO = ^TSF_BROADCAST_INFO;
+  TSF_BROADCAST_INFO = record
+                         description          : array[0..255] of ctypes.cchar;
+                         originator           : array[0..31]  of ctypes.cchar;
+                         originator_reference : array[0..31]  of ctypes.cchar;
+                         origination_date     : array[0..9]   of ctypes.cchar;
+                         origination_time     : array[0..7]   of ctypes.cchar;
+                         time_reference_low   : ctypes.cint;
+                         time_reference_high  : ctypes.cint;
+                         version              : ctypes.cshort;
+                         umid                 : array[0..63]  of ctypes.cchar;
+                         reserved             : array[0..189] of ctypes.cchar;
+                         coding_history_size  : ctypes.cuint;
+                         coding_history       : array[0..255] of ctypes.cchar;
+                       end;
+
+type
+   Tsf_vio_get_filelen = function (user_date : pointer) : Tsf_count_t;           cdecl;
+   
+   Tsf_vio_seek        = function (offest : Tsf_count_t; whence : ctypes.cint;
+                                   user_date : pointer) : Tsf_count_t;           cdecl;
+                                   
+   Tsf_vio_read        = function (ptr : Pointer; count : Tsf_count_t;
+                                   user_date : pointer) : Tsf_count_t;           cdecl;
+
+   Tsf_vio_write       = function (ptr : Pointer; count : Tsf_count_t;
+                                   user_date : pointer) : Tsf_count_t;           cdecl;
+                                   
+   Tsf_vio_tell        = function (user_data : Pointer) : Tsf_count_t;           cdecl;
+
+
+   PSF_VIRTUAL_IO = ^TSF_VIRTUAL_IO;
+   TSF_VIRTUAL_IO = record
+                      get_filelen : Tsf_vio_get_filelen;
+                      seek        : Tsf_vio_seek;
+                      read        : Tsf_vio_read;
+                      write       : Tsf_vio_write;
+                      tell        : Tsf_vio_tell;
+                    end;
 
-  function sf_read_float(sndfile:PSNDFILE; ptr:Pdouble; items:size_t):size_t;cdecl;external External_library name 'sf_read_float';
+{
+** Open the specified file for read, write or both. On error, this will
+** return a NULL pointer. To find the error number, pass a NULL SNDFILE
+** to sf_perror () or sf_error_str ().
+** All calls to sf_open() should be matched with a call to sf_close().
+}
+function sf_open (path : ctypes.pcchar; mode : ctypes.cint; sfinfo : PSF_INFO) : PSNDFILE; cdecl;
+  external sndfilelib  name 'sf_open';
 
-  function sf_write_float(sndfile:PSNDFILE; ptr:Pdouble; items:size_t):size_t;cdecl;external External_library name 'sf_write_float';
+{
+** Use the existing file descriptor to create a SNDFILE object. If close_desc
+** is TRUE, the file descriptor will be closed when sf_close() is called. If
+** it is FALSE, the descritor will not be closed.
+** When passed a descriptor like this, the library will assume that the start
+** of file header is at the current file offset. This allows sound files within
+** larger container files to be read and/or written.
+** On error, this will return a NULL pointer. To find the error number, pass a
+** NULL SNDFILE to sf_perror () or sf_error_str ().
+** All calls to sf_open_fd() should be matched with a call to sf_close().
+}
 
-  function sf_read_double(sndfile:PSNDFILE; ptr:Pdouble; items:size_t; normalize:longint):size_t;cdecl;external External_library name 'sf_read_double';
+function sf_open_fd (fd     : ctypes.cint; mode       : ctypes.cint;
+                     sfinfo : PSF_INFO;    close_desc : ctypes.cint) : PSNDFILE; cdecl;
+  external sndfilelib name 'sf_open_fd';
 
-  function sf_write_double(sndfile:PSNDFILE; ptr:Pdouble; items:size_t; normalize:longint):size_t;cdecl;external External_library name 'sf_write_double';
+function sf_open_virtual (sfvirtual : PSF_VIRTUAL_IO; mode      : ctypes.cint;
+                          sfinfo    : PSF_INFO;       user_data : Pointer) : PSNDFILE; cdecl;
+  external sndfilelib name 'sf_open_virtual';
 
-  function sf_close(sndfile:PSNDFILE):longint;cdecl;external External_library name 'sf_close';
+{
+** sf_error () returns a error number which can be translated to a text
+** string using sf_error_number().
+}
 
-implementation
+function sf_error (sndfile : PSNDFILE) : ctypes.cint; cdecl;
+  external sndfilelib name 'sf_error';
+
+{
+** sf_strerror () returns to the caller a pointer to the current error message for
+** the given SNDFILE.
+}
+
+function sf_strerror (sndfile : PSNDFILE) : ctypes.pcchar; cdecl;
+  external sndfilelib name 'sf_strerror';
+
+{
+** sf_error_number () allows the retrieval of the error string for each internal
+** error number.
+}
+
+function sf_error_number (errnum : ctypes.cint) : ctypes.pcchar; cdecl;
+  external sndfilelib name 'sf_error_number';
+
+{
+** The following three error functions are deprecated but they will remain in the
+** library for the forseeable future. The function sf_strerror() should be used
+** in their place.
+}
+
+function sf_perror (sndfile : PSNDFILE) : ctypes.cint; cdecl;
+  external sndfilelib name 'sf_perror';
+
+function sf_error_str (sndfile : PSNDFILE; str : ctypes.pcchar;
+                       len     : size_t) : ctypes.cint; cdecl;
+  external sndfilelib name 'sf_error_str';
+
+// Return TRUE if fields of the SF_INFO struct are a valid combination of values.
 
+function sf_command (sndfile : PSNDFILE; command  : ctypes.cint;
+                     data    : Pointer;  datasize : ctypes.cint) : ctypes.cint; cdecl;
+  external sndfilelib name 'sf_command';
+
+// Return TRUE if fields of the SF_INFO struct are a valid combination of values.
+
+function sf_format_check (info : PSF_INFO) : ctypes.cint; cdecl;
+  external sndfilelib name 'sf_format_check';
+
+{
+** Seek within the waveform data chunk of the SNDFILE. sf_seek () uses
+** the same values for whence (SEEK_SET, SEEK_CUR and SEEK_END) as
+** stdio.h function fseek ().
+** An offset of zero with whence set to SEEK_SET will position the
+** read / write pointer to the first data sample.
+** On success sf_seek returns the current position in (multi-channel)
+** samples from the start of the file.
+** Please see the libsndfile documentation for moving the read pointer
+** separately from the write pointer on files open in mode SFM_RDWR.
+** On error all of these functions return -1.
+}
+
+function sf_seek (sndfile : PSNDFILE; frame : Tsf_count_t;
+                  whence  : ctypes.cint) : Tsf_count_t; cdecl;
+  external sndfilelib name 'sf_seek';
+
+{
+** Functions for retrieving and setting string data within sound files.
+** Not all file types support this features; AIFF and WAV do. For both
+** functions, the str_type parameter must be one of the SF_STR_* values
+** defined above.
+** On error, sf_set_string() returns non-zero while sf_get_string()
+** returns NULL.
+}
+
+function sf_set_string (sndfile : PSNDFILE;      str_type : ctypes.cint;
+                        str     : ctypes.pcchar) : ctypes.cint; cdecl;
+  external sndfilelib name 'sf_set_string';
+  
+function sf_get_string (sndfile : PSNDFILE; str_type : ctypes.cint) : ctypes.pcchar; cdecl;
+  external sndfilelib name 'sf_get_string';
+
+// Functions for reading/writing the waveform data of a sound file.
+
+function sf_read_raw (sndfile : PSNDFILE; ptr : Pointer;
+                      bytes   : Tsf_count_t) : Tsf_count_t; cdecl;
+  external sndfilelib name 'sf_read_raw';
+  
+function sf_write_raw (sndfile : PSNDFILE; ptr : Pointer;
+                      bytes   : Tsf_count_t) : Tsf_count_t; cdecl;
+  external sndfilelib name 'sf_write_raw';
+
+{
+** Functions for reading and writing the data chunk in terms of frames.
+** The number of items actually read/written = frames * number of channels.
+**     sf_xxxx_raw		read/writes the raw data bytes from/to the file
+**     sf_xxxx_short	passes data in the native short format
+**     sf_xxxx_int		passes data in the native int format
+**     sf_xxxx_float	passes data in the native float format
+**     sf_xxxx_double	passes data in the native double format
+** All of these read/write function return number of frames read/written.
+}
+
+function sf_readf_short (sndfile : PSNDFILE; ptr : ctypes.pcshort;
+                         frames  : Tsf_count_t) : Tsf_count_t; cdecl;
+  external sndfilelib name 'sf_readf_short';
+                         
+function sf_writef_short (sndfile : PSNDFILE; ptr : ctypes.pcshort;
+                          frames  : Tsf_count_t) : Tsf_count_t; cdecl;
+  external sndfilelib name 'sf_writef_short';
+
+function sf_readf_int (sndfile : PSNDFILE; ptr : ctypes.pcint;
+                       frames  : Tsf_count_t) : Tsf_count_t; cdecl;
+  external sndfilelib name 'sf_readf_int';
+
+function sf_writef_int (sndfile : PSNDFILE; ptr : ctypes.pcint;
+                        frames  : Tsf_count_t) : Tsf_count_t; cdecl;
+  external sndfilelib name 'sf_writef_int';
+
+function sf_readf_float (sndfile : PSNDFILE; ptr : ctypes.pcfloat;
+                         frames  : Tsf_count_t) : Tsf_count_t; cdecl;
+  external sndfilelib name 'sf_readf_float';
+
+function sf_writef_float (sndfile : PSNDFILE; ptr : ctypes.pcfloat;
+                          frames  : Tsf_count_t) : Tsf_count_t; cdecl;
+  external sndfilelib name 'sf_writef_float';
+
+function sf_readf_double (sndfile : PSNDFILE; ptr : ctypes.pcdouble;
+                          frames  : Tsf_count_t) : Tsf_count_t; cdecl;
+  external sndfilelib name 'sf_readf_double';
+
+function sf_writef_double (sndfile : PSNDFILE; ptr : ctypes.pcdouble;
+                           frames  : Tsf_count_t) : Tsf_count_t; cdecl;
+  external sndfilelib name 'sf_writef_double';
+
+{
+** Functions for reading and writing the data chunk in terms of items.
+** Otherwise similar to above.
+** All of these read/write function return number of items read/written.
+}
+
+function sf_read_short (sndfile : PSNDFILE; ptr : ctypes.pcshort;
+                        frames  : Tsf_count_t) : Tsf_count_t; cdecl;
+  external sndfilelib name 'sf_read_short';
+
+function sf_write_short (sndfile : PSNDFILE; ptr : ctypes.pcshort;
+                         frames  : Tsf_count_t) : Tsf_count_t; cdecl;
+  external sndfilelib name 'sf_write_short';
+
+function sf_read_int (sndfile : PSNDFILE; ptr : ctypes.pcint;
+                      frames  : Tsf_count_t) : Tsf_count_t; cdecl;
+  external sndfilelib name 'sf_read_int';
+
+function sf_write_int (sndfile : PSNDFILE; ptr : ctypes.pcint;
+                       frames  : Tsf_count_t) : Tsf_count_t; cdecl;
+  external sndfilelib name 'sf_write_int';
+
+function sf_read_float (sndfile : PSNDFILE; ptr : ctypes.pcfloat;
+                        frames  : Tsf_count_t) : Tsf_count_t; cdecl;
+  external sndfilelib name 'sf_read_float';
+  
+function sf_write_float (sndfile : PSNDFILE; ptr : ctypes.pcfloat;
+                         frames  : Tsf_count_t) : Tsf_count_t; cdecl;
+  external sndfilelib name 'sf_write_float';
+
+function sf_read_double (sndfile : PSNDFILE; ptr : ctypes.pcdouble;
+                         frames  : Tsf_count_t) : Tsf_count_t; cdecl;
+  external sndfilelib name 'sf_read_double';
+
+function sf_write_double (sndfile : PSNDFILE; ptr : ctypes.pcdouble;
+                          frames  : Tsf_count_t) : Tsf_count_t; cdecl;
+  external sndfilelib name 'sf_write_double';
+
+{
+** Close the SNDFILE and clean up all memory allocations associated with this
+** file.
+** Returns 0 on success, or an error number.
+}
+
+function sf_close (sndfile : PSNDFILE) : ctypes.cint; cdecl;
+  external sndfilelib name 'sf_close';
+
+{
+** If the file is opened SFM_WRITE or SFM_RDWR, call fsync() on the file
+** to force the writing of data to disk. If the file is opened SFM_READ
+** no action is taken.
+}
+
+procedure sf_write_sync (sndfile : PSNDFILE); cdecl;
+  external sndfilelib name 'sf_write_sync';
+
+implementation
 
 end.
+

packages/fcl-base/src/inc/inifiles.pp

@@ -123,6 +123,7 @@ type
     FSectionList: TIniFileSectionList;
     FEscapeLineFeeds: boolean;
     FCaseSensitive : Boolean; 
+    FStripQuotes : Boolean;
   public
     constructor Create(const AFileName: string; AEscapeLineFeeds : Boolean = False); virtual;
     destructor Destroy; override;
@@ -153,6 +154,7 @@ type
     property FileName: string read FFileName;
     property EscapeLineFeeds: boolean read FEscapeLineFeeds;
     Property CaseSensitive : Boolean Read FCaseSensitive Write FCaseSensitive;
+    Property StripQuotes : Boolean Read FStripQuotes Write FStripQuotes;
   end;
 
   { TIniFile }
@@ -722,12 +724,15 @@ begin
            begin
              sIdent:=Trim(Copy(sLine, 1,  j - 1));
              sValue:=Trim(Copy(sLine, j + 1, Length(sLine) - j));
-             J:=Length(sValue);
-             // Joost, 2-jan-2007: The check (J>1) is there for the case that
-             // the value consist of a single double-quote character. (see
-             // mantis bug 6555)
-             If (J>1) and (sValue[1]='"') and (sValue[J]='"') then
-               sValue:=Copy(sValue,2,J-2);
+             If StripQuotes then
+               begin
+               J:=Length(sValue);
+               // Joost, 2-jan-2007: The check (J>1) is there for the case that
+               // the value consist of a single double-quote character. (see
+               // mantis bug 6555)
+               If (J>1) and (sValue[1]='"') and (sValue[J]='"') then
+                 sValue:=Copy(sValue,2,J-2);
+               end;  
            end;
         end;
         oSection.KeyList.Add(TIniFileKey.Create(sIdent, sValue));

packages/fcl-base/src/inc/process.pp

@@ -56,10 +56,8 @@ Type
     FCurrentDirectory : String;
     FDesktop : String;
     FEnvironment : Tstrings;
-    FExitCode : Cardinal;
     FShowWindow : TShowWindowOptions;
     FInherithandles : Boolean;
-    FRunning : Boolean;
     FProcessPriority : TProcessPriority;
     dwXCountchars,
     dwXSize,
@@ -85,6 +83,8 @@ Type
     procedure SetEnvironment(const Value: TStrings);
     function  PeekExitStatus: Boolean;
   Protected  
+    FRunning : Boolean;
+    FExitCode : Cardinal;
     FInputStream  : TOutputPipeStream;
     FOutputStream : TInputPipeStream;
     FStderrStream : TInputPipeStream;

packages/fcl-base/src/inc/zipper.pp

@@ -18,7 +18,7 @@ unit zipper;
 Interface
 
 Uses
-   SysUtils,Classes,Contnrs,ZStream;
+   SysUtils,Classes,ZStream;
 
 
 Const
@@ -320,7 +320,7 @@ Type
     FFileName   :  String;         { Name of resulting Zip file                 }
     FOutputPath : String;
     FFiles      : TStrings;
-    FZipEntries : TFPObjectList;
+    FZipEntries : TFPList;  { don't use TFPObjectList, becuase of Contnrs dependency }
     FOutFile    : TFileStream;
     FZipFile     : TFileStream;     { I/O file variables                         }
     LocalHdr    : Local_File_Header_Type;
@@ -1309,8 +1309,6 @@ Begin
 end;
 
 Function TUnZipper.CreateDeCompressor(Item : TZipItem; AMethod : Word;AZipFile,AOutFile : TStream) : TDeCompressor;
-var
-  Count : Int64;
 begin
   case AMethod of
     8 :
@@ -1369,7 +1367,7 @@ Begin
       ReadZipDirectory;
       For I:=0 to FZipEntries.Count-1 do
         begin
-          Item:=FZipEntries[i] as TZipItem;
+          Item:=TZipItem(FZipEntries[i]);
 	  if (FFiles=nil) or
 	     (FFiles.IndexOf(Item.Name)<>-1) then
             UnZipOneFile(Item);
@@ -1441,7 +1439,7 @@ Constructor TUnZipper.Create;
 begin
   FBufSize:=DefaultBufSize;
   FFiles:=TStringList.Create;
-  FZipEntries:=TFPObjectList.Create(true);
+  FZipEntries:=TFPList.Create;
   TStringlist(FFiles).Sorted:=True;
   FOnPercent:=1;
 end;
@@ -1455,6 +1453,8 @@ begin
   For I:=0 to FFiles.Count-1 do
     FFiles.Objects[i].Free;
   FFiles.Clear;
+  For I:=0 to FZipEntries.Count-1 do
+    TZipItem(FZipEntries[i]).Free;
   FZipEntries.Clear;
 end;
 

packages/fcl-base/tests/testunzip.pp

@@ -60,6 +60,7 @@ begin
   FParams:=TStringlist.Create;
   FDatasets:=TList.Create;
   FTransactions:=TList.Create;
+  FConnected:=False;
 end;
 
 destructor TDatabase.Destroy;

packages/fcl-db/src/db.pas

@@ -397,7 +397,7 @@ type
     property IsNull: Boolean read GetIsNull;
     property NewValue: Variant read GetNewValue write SetNewValue;
     property Offset: word read FOffset;
-    property Size: Word read FSize write FSize;
+    property Size: Word read FSize write SetSize;
     property Text: string read GetEditText write SetEditText;
     property ValidChars : TFieldChars Read FValidChars;
     property Value: variant read GetAsVariant write SetAsVariant;
@@ -1562,6 +1562,7 @@ type
     procedure InternalHandleException; virtual;
     procedure Loaded; override;
     procedure SetConnected (Value : boolean); virtual;
+    property Streamedconnected: Boolean read FStreamedConnected write FStreamedConnected;
   public
     procedure Close;
     destructor Destroy; override;
@@ -1571,7 +1572,6 @@ type
   published
     property Connected: Boolean read GetConnected write SetConnected;
     property LoginPrompt: Boolean read FLoginPrompt write FLoginPrompt;
-    property Streamedconnected: Boolean read FStreamedConnected write FStreamedConnected;
 
     property AfterConnect : TNotifyEvent read FAfterConnect write SetAfterConnect;
     property AfterDisconnect : TNotifyEvent read FAfterDisconnect write SetAfterDisconnect;

packages/fcl-db/src/dbase/Makefile

@@ -1,11 +1,12 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2007/10/21]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2007/10/30]
 #
 default: all
 MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos 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-win64 x86_64-embedded arm-linux arm-palmos arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded
 BSDs = freebsd netbsd openbsd darwin
 UNIXs = linux $(BSDs) solaris qnx
 LIMIT83fs = go32v2 os2 emx watcom
+OSNeedsComspecToRunBatch = go32v2 watcom
 FORCE:
 .PHONY: FORCE
 override PATH:=$(patsubst %/,%,$(subst \,/,$(PATH)))
@@ -56,6 +57,11 @@ else
 SRCBATCHEXT=.bat
 endif
 endif
+ifdef COMSPEC
+ifneq ($(findstring $(OS_SOURCE),$(OSNeedsComspecToRunBatch)),)
+RUNBATCH=$(COMSPEC) /C
+endif
+endif
 ifdef inUnix
 PATHSEP=/
 else
@@ -102,7 +108,11 @@ ifndef FPC
 FPCPROG:=$(strip $(wildcard $(addsuffix /fpc$(SRCEXEEXT),$(SEARCHPATH))))
 ifneq ($(FPCPROG),)
 FPCPROG:=$(firstword $(FPCPROG))
+ifneq ($(CPU_TARGET),)
+FPC:=$(shell $(FPCPROG) -P$(CPU_TARGET) -PB)
+else
 FPC:=$(shell $(FPCPROG) -PB)
+endif
 ifneq ($(findstring Error,$(FPC)),)
 override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
 endif
@@ -234,16 +244,10 @@ override PACKAGE_NAME=fcl-db
 PACKAGEDIR_MAIN:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /fcl-db/Makefile.fpc,$(PACKAGESDIR))))))
 ifneq ($(OS_TARGET),win32)
 ifneq ($(OS_TARGET),win64)
-ifeq ($(CPU_TARGET),i386)
-INSTALL_UNITS+=dbf_wtil
-CLEAN_UNITS+=dbf_wtil
-endif
-ifeq ($(CPU_TARGET),x86_64)
 INSTALL_UNITS+=dbf_wtil
 CLEAN_UNITS+=dbf_wtil
 endif
 endif
-endif
 ifeq ($(FULL_TARGET),i386-linux)
 override TARGET_UNITS+=dbf
 endif
@@ -301,6 +305,63 @@ endif
 ifeq ($(FULL_TARGET),i386-symbian)
 override TARGET_UNITS+=dbf
 endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override TARGET_UNITS+=dbf
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override TARGET_UNITS+=dbf
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override TARGET_UNITS+=dbf
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override TARGET_UNITS+=dbf
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override TARGET_UNITS+=dbf
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override TARGET_UNITS+=dbf
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override TARGET_UNITS+=dbf
+endif
+ifeq ($(FULL_TARGET),m68k-embedded)
+override TARGET_UNITS+=dbf
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override TARGET_UNITS+=dbf
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override TARGET_UNITS+=dbf
+endif
+ifeq ($(FULL_TARGET),powerpc-amiga)
+override TARGET_UNITS+=dbf
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override TARGET_UNITS+=dbf
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override TARGET_UNITS+=dbf
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override TARGET_UNITS+=dbf
+endif
+ifeq ($(FULL_TARGET),powerpc-embedded)
+override TARGET_UNITS+=dbf
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override TARGET_UNITS+=dbf
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override TARGET_UNITS+=dbf
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override TARGET_UNITS+=dbf
+endif
+ifeq ($(FULL_TARGET),sparc-embedded)
+override TARGET_UNITS+=dbf
+endif
 ifeq ($(FULL_TARGET),x86_64-linux)
 override TARGET_UNITS+=dbf
 endif
@@ -313,6 +374,36 @@ endif
 ifeq ($(FULL_TARGET),x86_64-embedded)
 override TARGET_UNITS+=dbf
 endif
+ifeq ($(FULL_TARGET),arm-linux)
+override TARGET_UNITS+=dbf
+endif
+ifeq ($(FULL_TARGET),arm-palmos)
+override TARGET_UNITS+=dbf
+endif
+ifeq ($(FULL_TARGET),arm-wince)
+override TARGET_UNITS+=dbf
+endif
+ifeq ($(FULL_TARGET),arm-gba)
+override TARGET_UNITS+=dbf
+endif
+ifeq ($(FULL_TARGET),arm-nds)
+override TARGET_UNITS+=dbf
+endif
+ifeq ($(FULL_TARGET),arm-embedded)
+override TARGET_UNITS+=dbf
+endif
+ifeq ($(FULL_TARGET),arm-symbian)
+override TARGET_UNITS+=dbf
+endif
+ifeq ($(FULL_TARGET),powerpc64-linux)
+override TARGET_UNITS+=dbf
+endif
+ifeq ($(FULL_TARGET),powerpc64-darwin)
+override TARGET_UNITS+=dbf
+endif
+ifeq ($(FULL_TARGET),powerpc64-embedded)
+override TARGET_UNITS+=dbf
+endif
 ifeq ($(FULL_TARGET),i386-linux)
 override TARGET_EXAMPLES+=testdbf
 endif
@@ -370,6 +461,63 @@ endif
 ifeq ($(FULL_TARGET),i386-symbian)
 override TARGET_EXAMPLES+=testdbf
 endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override TARGET_EXAMPLES+=testdbf
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override TARGET_EXAMPLES+=testdbf
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override TARGET_EXAMPLES+=testdbf
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override TARGET_EXAMPLES+=testdbf
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override TARGET_EXAMPLES+=testdbf
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override TARGET_EXAMPLES+=testdbf
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override TARGET_EXAMPLES+=testdbf
+endif
+ifeq ($(FULL_TARGET),m68k-embedded)
+override TARGET_EXAMPLES+=testdbf
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override TARGET_EXAMPLES+=testdbf
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override TARGET_EXAMPLES+=testdbf
+endif
+ifeq ($(FULL_TARGET),powerpc-amiga)
+override TARGET_EXAMPLES+=testdbf
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override TARGET_EXAMPLES+=testdbf
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override TARGET_EXAMPLES+=testdbf
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override TARGET_EXAMPLES+=testdbf
+endif
+ifeq ($(FULL_TARGET),powerpc-embedded)
+override TARGET_EXAMPLES+=testdbf
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override TARGET_EXAMPLES+=testdbf
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override TARGET_EXAMPLES+=testdbf
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override TARGET_EXAMPLES+=testdbf
+endif
+ifeq ($(FULL_TARGET),sparc-embedded)
+override TARGET_EXAMPLES+=testdbf
+endif
 ifeq ($(FULL_TARGET),x86_64-linux)
 override TARGET_EXAMPLES+=testdbf
 endif
@@ -382,6 +530,36 @@ endif
 ifeq ($(FULL_TARGET),x86_64-embedded)
 override TARGET_EXAMPLES+=testdbf
 endif
+ifeq ($(FULL_TARGET),arm-linux)
+override TARGET_EXAMPLES+=testdbf
+endif
+ifeq ($(FULL_TARGET),arm-palmos)
+override TARGET_EXAMPLES+=testdbf
+endif
+ifeq ($(FULL_TARGET),arm-wince)
+override TARGET_EXAMPLES+=testdbf
+endif
+ifeq ($(FULL_TARGET),arm-gba)
+override TARGET_EXAMPLES+=testdbf
+endif
+ifeq ($(FULL_TARGET),arm-nds)
+override TARGET_EXAMPLES+=testdbf
+endif
+ifeq ($(FULL_TARGET),arm-embedded)
+override TARGET_EXAMPLES+=testdbf
+endif
+ifeq ($(FULL_TARGET),arm-symbian)
+override TARGET_EXAMPLES+=testdbf
+endif
+ifeq ($(FULL_TARGET),powerpc64-linux)
+override TARGET_EXAMPLES+=testdbf
+endif
+ifeq ($(FULL_TARGET),powerpc64-darwin)
+override TARGET_EXAMPLES+=testdbf
+endif
+ifeq ($(FULL_TARGET),powerpc64-embedded)
+override TARGET_EXAMPLES+=testdbf
+endif
 ifeq ($(FULL_TARGET),i386-linux)
 override CLEAN_UNITS+=dbf_collate dbf_common dbf_cursor dbf_dbffile dbf_fields dbf_idxcur dbf_idxfile dbf_lang dbf_memo dbf_parser dbf_pgfile dbf_prscore dbf_prsdef dbf_prssupp dbf_str
 endif
@@ -595,6 +773,63 @@ endif
 ifeq ($(FULL_TARGET),i386-symbian)
 override INSTALL_UNITS+=dbf_collate dbf_common dbf_cursor dbf_dbffile dbf_fields dbf_idxcur dbf_idxfile dbf_lang dbf_memo dbf_parser dbf_pgfile dbf_prscore dbf_prsdef dbf_prssupp dbf_str
 endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override INSTALL_UNITS+=dbf_collate dbf_common dbf_cursor dbf_dbffile dbf_fields dbf_idxcur dbf_idxfile dbf_lang dbf_memo dbf_parser dbf_pgfile dbf_prscore dbf_prsdef dbf_prssupp dbf_str
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override INSTALL_UNITS+=dbf_collate dbf_common dbf_cursor dbf_dbffile dbf_fields dbf_idxcur dbf_idxfile dbf_lang dbf_memo dbf_parser dbf_pgfile dbf_prscore dbf_prsdef dbf_prssupp dbf_str
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override INSTALL_UNITS+=dbf_collate dbf_common dbf_cursor dbf_dbffile dbf_fields dbf_idxcur dbf_idxfile dbf_lang dbf_memo dbf_parser dbf_pgfile dbf_prscore dbf_prsdef dbf_prssupp dbf_str
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override INSTALL_UNITS+=dbf_collate dbf_common dbf_cursor dbf_dbffile dbf_fields dbf_idxcur dbf_idxfile dbf_lang dbf_memo dbf_parser dbf_pgfile dbf_prscore dbf_prsdef dbf_prssupp dbf_str
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override INSTALL_UNITS+=dbf_collate dbf_common dbf_cursor dbf_dbffile dbf_fields dbf_idxcur dbf_idxfile dbf_lang dbf_memo dbf_parser dbf_pgfile dbf_prscore dbf_prsdef dbf_prssupp dbf_str
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override INSTALL_UNITS+=dbf_collate dbf_common dbf_cursor dbf_dbffile dbf_fields dbf_idxcur dbf_idxfile dbf_lang dbf_memo dbf_parser dbf_pgfile dbf_prscore dbf_prsdef dbf_prssupp dbf_str
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override INSTALL_UNITS+=dbf_collate dbf_common dbf_cursor dbf_dbffile dbf_fields dbf_idxcur dbf_idxfile dbf_lang dbf_memo dbf_parser dbf_pgfile dbf_prscore dbf_prsdef dbf_prssupp dbf_str
+endif
+ifeq ($(FULL_TARGET),m68k-embedded)
+override INSTALL_UNITS+=dbf_collate dbf_common dbf_cursor dbf_dbffile dbf_fields dbf_idxcur dbf_idxfile dbf_lang dbf_memo dbf_parser dbf_pgfile dbf_prscore dbf_prsdef dbf_prssupp dbf_str
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override INSTALL_UNITS+=dbf_collate dbf_common dbf_cursor dbf_dbffile dbf_fields dbf_idxcur dbf_idxfile dbf_lang dbf_memo dbf_parser dbf_pgfile dbf_prscore dbf_prsdef dbf_prssupp dbf_str
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override INSTALL_UNITS+=dbf_collate dbf_common dbf_cursor dbf_dbffile dbf_fields dbf_idxcur dbf_idxfile dbf_lang dbf_memo dbf_parser dbf_pgfile dbf_prscore dbf_prsdef dbf_prssupp dbf_str
+endif
+ifeq ($(FULL_TARGET),powerpc-amiga)
+override INSTALL_UNITS+=dbf_collate dbf_common dbf_cursor dbf_dbffile dbf_fields dbf_idxcur dbf_idxfile dbf_lang dbf_memo dbf_parser dbf_pgfile dbf_prscore dbf_prsdef dbf_prssupp dbf_str
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override INSTALL_UNITS+=dbf_collate dbf_common dbf_cursor dbf_dbffile dbf_fields dbf_idxcur dbf_idxfile dbf_lang dbf_memo dbf_parser dbf_pgfile dbf_prscore dbf_prsdef dbf_prssupp dbf_str
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override INSTALL_UNITS+=dbf_collate dbf_common dbf_cursor dbf_dbffile dbf_fields dbf_idxcur dbf_idxfile dbf_lang dbf_memo dbf_parser dbf_pgfile dbf_prscore dbf_prsdef dbf_prssupp dbf_str
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override INSTALL_UNITS+=dbf_collate dbf_common dbf_cursor dbf_dbffile dbf_fields dbf_idxcur dbf_idxfile dbf_lang dbf_memo dbf_parser dbf_pgfile dbf_prscore dbf_prsdef dbf_prssupp dbf_str
+endif
+ifeq ($(FULL_TARGET),powerpc-embedded)
+override INSTALL_UNITS+=dbf_collate dbf_common dbf_cursor dbf_dbffile dbf_fields dbf_idxcur dbf_idxfile dbf_lang dbf_memo dbf_parser dbf_pgfile dbf_prscore dbf_prsdef dbf_prssupp dbf_str
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override INSTALL_UNITS+=dbf_collate dbf_common dbf_cursor dbf_dbffile dbf_fields dbf_idxcur dbf_idxfile dbf_lang dbf_memo dbf_parser dbf_pgfile dbf_prscore dbf_prsdef dbf_prssupp dbf_str
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override INSTALL_UNITS+=dbf_collate dbf_common dbf_cursor dbf_dbffile dbf_fields dbf_idxcur dbf_idxfile dbf_lang dbf_memo dbf_parser dbf_pgfile dbf_prscore dbf_prsdef dbf_prssupp dbf_str
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override INSTALL_UNITS+=dbf_collate dbf_common dbf_cursor dbf_dbffile dbf_fields dbf_idxcur dbf_idxfile dbf_lang dbf_memo dbf_parser dbf_pgfile dbf_prscore dbf_prsdef dbf_prssupp dbf_str
+endif
+ifeq ($(FULL_TARGET),sparc-embedded)
+override INSTALL_UNITS+=dbf_collate dbf_common dbf_cursor dbf_dbffile dbf_fields dbf_idxcur dbf_idxfile dbf_lang dbf_memo dbf_parser dbf_pgfile dbf_prscore dbf_prsdef dbf_prssupp dbf_str
+endif
 ifeq ($(FULL_TARGET),x86_64-linux)
 override INSTALL_UNITS+=dbf_collate dbf_common dbf_cursor dbf_dbffile dbf_fields dbf_idxcur dbf_idxfile dbf_lang dbf_memo dbf_parser dbf_pgfile dbf_prscore dbf_prsdef dbf_prssupp dbf_str
 endif
@@ -607,6 +842,36 @@ endif
 ifeq ($(FULL_TARGET),x86_64-embedded)
 override INSTALL_UNITS+=dbf_collate dbf_common dbf_cursor dbf_dbffile dbf_fields dbf_idxcur dbf_idxfile dbf_lang dbf_memo dbf_parser dbf_pgfile dbf_prscore dbf_prsdef dbf_prssupp dbf_str
 endif
+ifeq ($(FULL_TARGET),arm-linux)
+override INSTALL_UNITS+=dbf_collate dbf_common dbf_cursor dbf_dbffile dbf_fields dbf_idxcur dbf_idxfile dbf_lang dbf_memo dbf_parser dbf_pgfile dbf_prscore dbf_prsdef dbf_prssupp dbf_str
+endif
+ifeq ($(FULL_TARGET),arm-palmos)
+override INSTALL_UNITS+=dbf_collate dbf_common dbf_cursor dbf_dbffile dbf_fields dbf_idxcur dbf_idxfile dbf_lang dbf_memo dbf_parser dbf_pgfile dbf_prscore dbf_prsdef dbf_prssupp dbf_str
+endif
+ifeq ($(FULL_TARGET),arm-wince)
+override INSTALL_UNITS+=dbf_collate dbf_common dbf_cursor dbf_dbffile dbf_fields dbf_idxcur dbf_idxfile dbf_lang dbf_memo dbf_parser dbf_pgfile dbf_prscore dbf_prsdef dbf_prssupp dbf_str
+endif
+ifeq ($(FULL_TARGET),arm-gba)
+override INSTALL_UNITS+=dbf_collate dbf_common dbf_cursor dbf_dbffile dbf_fields dbf_idxcur dbf_idxfile dbf_lang dbf_memo dbf_parser dbf_pgfile dbf_prscore dbf_prsdef dbf_prssupp dbf_str
+endif
+ifeq ($(FULL_TARGET),arm-nds)
+override INSTALL_UNITS+=dbf_collate dbf_common dbf_cursor dbf_dbffile dbf_fields dbf_idxcur dbf_idxfile dbf_lang dbf_memo dbf_parser dbf_pgfile dbf_prscore dbf_prsdef dbf_prssupp dbf_str
+endif
+ifeq ($(FULL_TARGET),arm-embedded)
+override INSTALL_UNITS+=dbf_collate dbf_common dbf_cursor dbf_dbffile dbf_fields dbf_idxcur dbf_idxfile dbf_lang dbf_memo dbf_parser dbf_pgfile dbf_prscore dbf_prsdef dbf_prssupp dbf_str
+endif
+ifeq ($(FULL_TARGET),arm-symbian)
+override INSTALL_UNITS+=dbf_collate dbf_common dbf_cursor dbf_dbffile dbf_fields dbf_idxcur dbf_idxfile dbf_lang dbf_memo dbf_parser dbf_pgfile dbf_prscore dbf_prsdef dbf_prssupp dbf_str
+endif
+ifeq ($(FULL_TARGET),powerpc64-linux)
+override INSTALL_UNITS+=dbf_collate dbf_common dbf_cursor dbf_dbffile dbf_fields dbf_idxcur dbf_idxfile dbf_lang dbf_memo dbf_parser dbf_pgfile dbf_prscore dbf_prsdef dbf_prssupp dbf_str
+endif
+ifeq ($(FULL_TARGET),powerpc64-darwin)
+override INSTALL_UNITS+=dbf_collate dbf_common dbf_cursor dbf_dbffile dbf_fields dbf_idxcur dbf_idxfile dbf_lang dbf_memo dbf_parser dbf_pgfile dbf_prscore dbf_prsdef dbf_prssupp dbf_str
+endif
+ifeq ($(FULL_TARGET),powerpc64-embedded)
+override INSTALL_UNITS+=dbf_collate dbf_common dbf_cursor dbf_dbffile dbf_fields dbf_idxcur dbf_idxfile dbf_lang dbf_memo dbf_parser dbf_pgfile dbf_prscore dbf_prsdef dbf_prssupp dbf_str
+endif
 override INSTALL_FPCPACKAGE=y
 ifeq ($(FULL_TARGET),i386-linux)
 override COMPILER_OPTIONS+=-S2 -Sh
@@ -1708,7 +1973,7 @@ override FPCOPT+=-FD$(NEW_BINUTILS_PATH)
 endif
 ifndef CROSSBOOTSTRAP
 ifneq ($(BINUTILSPREFIX),)
-override FPCOPT+=-XP$(BINUTILSPREFIX) 
+override FPCOPT+=-XP$(BINUTILSPREFIX)
 endif
 ifneq ($(BINUTILSPREFIX),)
 override FPCOPT+=-Xr$(RLINKPATH)
@@ -1840,9 +2105,13 @@ ifeq (,$(findstring -s ,$(COMPILER)))
 EXECPPAS=
 else
 ifeq ($(FULL_SOURCE),$(FULL_TARGET))
+ifdef RUNBATCH
+EXECPPAS:=@$(RUNBATCH) $(PPAS)
+else
 EXECPPAS:=@$(PPAS)
 endif
 endif
+endif
 .PHONY: fpc_units
 ifneq ($(TARGET_UNITS),)
 override ALLTARGET+=fpc_units

packages/fcl-db/src/dbase/Makefile.fpc

@@ -6,11 +6,8 @@
 main=fcl-db
 
 [target]
-units_i386=dbf
-examples_i386=testdbf
-
-units_x86_64=dbf
-examples_x86_64=testdbf
+units=dbf
+examples=testdbf
 
 [compiler]
 options=-S2 -Sh
@@ -20,12 +17,7 @@ fpcdir=../../../..
 
 [install]
 fpcpackage=y
-units_i386=dbf_collate dbf_common dbf_cursor dbf_dbffile dbf_fields \
-      dbf_idxcur dbf_idxfile dbf_lang dbf_memo dbf_parser dbf_pgfile \
-      dbf_prscore dbf_prsdef dbf_prssupp dbf_str
-
-
-units_x86_64=dbf_collate dbf_common dbf_cursor dbf_dbffile dbf_fields \
+units=dbf_collate dbf_common dbf_cursor dbf_dbffile dbf_fields \
       dbf_idxcur dbf_idxfile dbf_lang dbf_memo dbf_parser dbf_pgfile \
       dbf_prscore dbf_prsdef dbf_prssupp dbf_str
 
@@ -39,15 +31,8 @@ units=dbf_collate dbf_common dbf_cursor dbf_dbffile dbf_fields \
 ifneq ($(OS_TARGET),win32)
 ifneq ($(OS_TARGET),win64)
 
-ifeq ($(CPU_TARGET),i386)
 INSTALL_UNITS+=dbf_wtil
 CLEAN_UNITS+=dbf_wtil
-endif
-
-ifeq ($(CPU_TARGET),x86_64)
-INSTALL_UNITS+=dbf_wtil
-CLEAN_UNITS+=dbf_wtil
-endif
 
 endif
 endif

packages/fcl-db/src/dbase/dbf.pas

@@ -257,7 +257,7 @@ type
     function  IsCursorOpen: Boolean; override; {virtual abstract}
     procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override; {virtual abstract}
     procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override; {virtual abstract}
-    procedure SetFieldData(Field: TField; Buffer: Pointer); 
+    procedure SetFieldData(Field: TField; Buffer: Pointer);
       {$ifdef SUPPORT_OVERLOAD} overload; {$endif} override; {virtual abstract}
 
     { virtual methods (mostly optionnal) }
@@ -300,10 +300,10 @@ type
 {$endif}
 
 {$ifdef SUPPORT_OVERLOAD}
-    function  GetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean): Boolean; overload;
-      {$ifdef SUPPORT_BACKWARD_FIELDDATA} override; {$endif}
-    procedure SetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean); overload;
-      {$ifdef SUPPORT_BACKWARD_FIELDDATA} override; {$endif}
+    function  GetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean): Boolean;
+      {$ifdef SUPPORT_BACKWARD_FIELDDATA} overload; override; {$else} reintroduce; overload; {$endif}
+    procedure SetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean);
+      {$ifdef SUPPORT_BACKWARD_FIELDDATA} overload; override; {$else} reintroduce; overload; {$endif}
 {$endif}
 
     function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; override;
@@ -440,8 +440,10 @@ type
     property AfterCancel;
     property BeforeDelete;
     property AfterDelete;
+{$ifdef SUPPORT_REFRESHEVENTS}    
     property BeforeRefresh;
     property AfterRefresh;
+{$endif}    
     property BeforeScroll;
     property AfterScroll;
     property OnCalcFields;
@@ -2223,7 +2225,7 @@ begin
     begin
       FParser := TDbfParser.Create(FDbfFile);
       // we need truncated, translated (to ANSI) strings
-      FParser.RawStringFields := false;
+      FParser.StringFieldMode := smAnsiTrim;
     end;
     // have a parser now?
     if FParser <> nil then

packages/fcl-db/src/dbase/dbf_avl.pas

@@ -38,7 +38,7 @@ type
     FOnDelete: TAvlTreeEvent;
     FHeightChange: Boolean;
 
-    procedure InternalInsert(X: PNode; var P: PNode);
+    function  InternalInsert(X: PNode; var P: PNode): Boolean;
     procedure InternalDelete(X: TKeyType; var P: PNode);
 
     procedure DeleteNode(X: PNode);
@@ -49,7 +49,7 @@ type
 
     procedure Clear;
     function  Find(Key: TKeyType): TExtraData;
-    procedure Insert(Key: TKeyType; Extra: TExtraData);
+    function  Insert(Key: TKeyType; Extra: TExtraData): Boolean;
     procedure Delete(Key: TKeyType);
 
     function  Lowest: PData;
@@ -271,7 +271,7 @@ begin
     Result := nil;
 end;
 
-procedure TAvlTree.Insert(Key: TKeyType; Extra: TExtraData);
+function TAvlTree.Insert(Key: TKeyType; Extra: TExtraData): boolean;
 var
   H: PNode;
 begin
@@ -286,7 +286,9 @@ begin
     Bal := 0;
   end;
   // insert new node
-  InternalInsert(H, FRoot);
+  Result := InternalInsert(H, FRoot);
+  if not Result then
+    Dispose(H);
   // check tree
 //  assert(CheckTree(FRoot));
 end;
@@ -297,15 +299,19 @@ begin
 //  assert(CheckTree(FRoot));
 end;
 
-procedure TAvlTree.InternalInsert(X: PNode; var P: PNode);
+function TAvlTree.InternalInsert(X: PNode; var P: PNode): boolean;
 begin
-  if P = nil
-  then begin P := X; Inc(FCount); FHeightChange := true end
-  else
+  if P = nil then 
+  begin 
+    P := X; 
+    Inc(FCount); 
+    FHeightChange := true;
+    Result := true;
+  end else begin
     if X^.Data.ID < P^.Data.ID then
     begin
       { less }
-      InternalInsert(X, P^.Left);
+      Result := InternalInsert(X, P^.Left);
       if FHeightChange then {Left branch has grown higher}
         case P^.Bal of
           1: begin P^.Bal := 0; FHeightChange := false end;
@@ -338,7 +344,7 @@ begin
     if X^.Data.ID > P^.Data.ID then
     begin
       { greater }
-      InternalInsert(X, P^.Right);
+      Result := InternalInsert(X, P^.Right);
       if FHeightChange then {Right branch has grown higher}
         case P^.Bal of
           -1: begin P^.Bal := 0; FHeightChange := false end;
@@ -370,8 +376,9 @@ begin
     end {greater} else begin
       {X already present; do not insert again}
       FHeightChange := false;
+      Result := false;
     end;
-
+  end;
 //  assert(CheckTree(P));
 end;{InternalInsert}
 

packages/fcl-db/src/dbase/dbf_collate.pas

@@ -1,4 +1,4 @@
-unit Dbf_Collate;
+unit dbf_collate;
 
 {$i dbf_common.inc}
 
@@ -763,7 +763,7 @@ const
   db866ru0 :PCollationTable = @_db866ru0;
 
 
-
+{$ifdef USE_BORLAND_COLLATION_TABLES}
 
   // BLLT1DA0    64770
 
@@ -926,7 +926,7 @@ const
   );
   BLLT1NO0 :PCollationTable = @_BLLT1NO0;
 
-
+{$endif}
 
 
   // DB850US0      Checksum: 43413
@@ -954,7 +954,7 @@ const
 
 
 
-  {$IFDEF PARADOX_COLLATIONS}
+{$ifdef USE_PARADOX_COLLATIONS}
 
   // intl850    43039
 
@@ -978,12 +978,6 @@ const
   );
   intl850 :PCollationTable = @_intl850;
 
-  {$ENDIF}
-
-
-
-
-  {$IFDEF PARADOX_COLLATIONS}
 
   // SPANISH    20109
 
@@ -1007,12 +1001,10 @@ const
   );
   SPANISH :PCollationTable = @_SPANISH;
 
-  {$ENDIF}
 
 
 
 
-  {$IFDEF PARADOX_COLLATIONS}
 
   // iceland    23936
 
@@ -1036,12 +1028,10 @@ const
   );
   iceland :PCollationTable = @_iceland;
 
-  {$ENDIF}
 
 
 
 
-  {$IFDEF PARADOX_COLLATIONS}
 
   // ANSIINTL    58462
 
@@ -1065,12 +1055,10 @@ const
   );
   ANSIINTL :PCollationTable = @_ANSIINTL;
 
-  {$ENDIF}
 
 
 
 
-  {$IFDEF PARADOX_COLLATIONS}
 
   // ANSII850    29000
 
@@ -1094,12 +1082,10 @@ const
   );
   ANSII850 :PCollationTable = @_ANSII850;
 
-  {$ENDIF}
 
 
 
 
-  {$IFDEF PARADOX_COLLATIONS}
 
   // ANSISPAN    33308
 
@@ -1123,12 +1109,10 @@ const
   );
   ANSISPAN :PCollationTable = @_ANSISPAN;
 
-  {$ENDIF}
 
 
 
 
-  {$IFDEF PARADOX_COLLATIONS}
 
   // ANSISWFN    44782
 
@@ -1152,12 +1136,10 @@ const
   );
   ANSISWFN :PCollationTable = @_ANSISWFN;
 
-  {$ENDIF}
 
 
 
 
-  {$IFDEF PARADOX_COLLATIONS}
 
   // ANSINOR4    55290
 
@@ -1181,7 +1163,7 @@ const
   );
   ANSINOR4 :PCollationTable = @_ANSINOR4;
 
-  {$ENDIF}
+{$endif}
 
 
 
@@ -1206,11 +1188,6 @@ const
     096, 097, 098, 099, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, 111,
     112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122, 123, 124, 125, 126, 127
   );
-  china :PCollationTable = @_china;
-
-  korea :PCollationTable = @_china;
-
-  taiwan :PCollationTable = @_china;
 
   DB936CN0 :PCollationTable = @_china;
 
@@ -1241,7 +1218,16 @@ const
     247, 248, 249, 250, 251, 195, 196, 176, 177, 178, 179, 180, 181, 182, 197, 198, 
     199, 200, 201, 202, 203, 204, 205, 206, 207, 208, 209, 210, 252, 253, 254, 255
   );
+
+{$ifdef USE_PARADOX_COLLATIONS}
+  china :PCollationTable = @_china;
+
+  korea :PCollationTable = @_china;
+
+  taiwan :PCollationTable = @_china;
+
   thai :PCollationTable = @_thai;
+{$endif}
 
   db874th0 :PCollationTable = @_thai;
 
@@ -1298,7 +1284,7 @@ const
   DBWINES0 :PCollationTable = @_DBWINWE0;
 
 
-
+{$ifdef USE_ACCESS_COLLATIONS}
 
   // ACCGEN    19621
 
@@ -1372,7 +1358,7 @@ const
   );
   ACCSWFIN :PCollationTable = @_ACCSWFIN;
 
-
+{$endif}
 
 
   // FOXDE437      Checksum: 21075
@@ -1500,7 +1486,7 @@ const
 
 
 
-  {$IFDEF PARADOX_COLLATIONS}
+{$ifdef USE_PARADOX_COLLATIONS}
 
   // czech    30844
 
@@ -1531,7 +1517,6 @@ const
 
   czechw :PCollationTable = @_czech;
 
-  {$ENDIF}
 
 
 
@@ -1561,7 +1546,6 @@ const
 
 
 
-  {$IFDEF PARADOX_COLLATIONS}
 
   // polish    59020
 
@@ -1585,12 +1569,10 @@ const
   );
   polish :PCollationTable = @_polish;
 
-  {$ENDIF}
 
 
 
 
-  {$IFDEF PARADOX_COLLATIONS}
 
   // cyrr    20081
 
@@ -1614,12 +1596,10 @@ const
   );
   cyrr :PCollationTable = @_cyrr;
 
-  {$ENDIF}
 
 
 
 
-  {$IFDEF PARADOX_COLLATIONS}
 
   // hun852dc    62898
 
@@ -1643,7 +1623,7 @@ const
   );
   hun852dc :PCollationTable = @_hun852dc;
 
-  {$ENDIF}
+{$endif}
 
 
 
@@ -1668,7 +1648,6 @@ const
     180, 149, 154, 157, 160, 161, 168, 176, 175, 181, 118, 123, 126, 129, 136, 142, 
     147, 241, 242, 243, 244, 245, 246, 247, 248, 249, 250, 251, 252, 253, 254, 255
   );
-  grcp437 :PCollationTable = @_grcp437;
 
   db437gr0 :PCollationTable = @_grcp437;
 
@@ -1697,7 +1676,6 @@ const
   );
   dbhebrew :PCollationTable = @_dbhebrew;
 
-  Hebrew :PCollationTable = @_dbhebrew;
 
 
 
@@ -1722,10 +1700,15 @@ const
     142, 158, 143, 133, 130, 131, 163, 162, 153, 177, 150, 178, 187, 189, 166, 242, 
     243, 244, 245, 246, 247, 248, 249, 250, 251, 252, 253, 173, 154, 151, 254, 255
   );
-  slovene :PCollationTable = @_slovene;
-
   db852sl0 :PCollationTable = @_slovene;
 
+{$ifdef USE_PARADOX_COLLATIONS}
+  grcp437 :PCollationTable = @_grcp437;
+
+  hebrew :PCollationTable = @_dbhebrew;
+
+  slovene :PCollationTable = @_slovene;
+{$endif}
 
 
 
@@ -1790,6 +1773,7 @@ const
 
 
 
+  {$IFDEF PARADOX_COLLATIONS}
 
   // cskamenw    40577
 
@@ -1815,6 +1799,8 @@ const
 
   cskamen :PCollationTable = @_cskamenw;
 
+  {$ENDIF}
+
 
 
 
@@ -1904,6 +1890,7 @@ const
 
 
 
+  {$IFDEF PARADOX_COLLATIONS}
 
   // angreek1    39126
 
@@ -1929,8 +1916,9 @@ const
 
   ACCGREEK :PCollationTable = @_angreek1;
 
+  {$ENDIF}
 
-
+  {$IFDEF PARADOX_COLLATIONS}
 
   // ansislov    61480
 
@@ -1954,8 +1942,11 @@ const
   );
   ansislov :PCollationTable = @_ansislov;
 
+  {$ENDIF}
+
 
 
+  {$IFDEF USE_PARADOX_COLLATIONS}
 
   // ANTURK    24004
 
@@ -1979,6 +1970,7 @@ const
   );
   ANTURK :PCollationTable = @_ANTURK;
 
+  {$ENDIF}
 
 
 
@@ -2056,6 +2048,7 @@ const
 
 
 
+  {$IFDEF USE_ACCESS_COLLATIONS}
 
   // BLROM800    28847
 
@@ -2079,8 +2072,10 @@ const
   );
   BLROM800 :PCollationTable = @_BLROM800;
 
+  {$ENDIF}
 
 
+  {$IFDEF USE_ORACLE_COLLATIONS}
 
   // ORAWE850    31378
 
@@ -2104,8 +2099,11 @@ const
   );
   ORAWE850 :PCollationTable = @_ORAWE850 ;
 
+  {$ENDIF}
+
 
 
+  {$IFDEF USE_SYBASE_COLLATIONS}
 
   // SYDC850    46023
 
@@ -2154,8 +2152,10 @@ const
   );
   SYDC437 :PCollationTable = @_SYDC437;
 
+  {$ENDIF}
 
 
+  {$IFDEF USE_DB2_COLLATIONS}
 
   // db2andeu    8683
 
@@ -2179,6 +2179,8 @@ const
   );
   db2andeu :PCollationTable = @_db2andeu;
 
+  {$ENDIF}
+
 initialization
 
   InitialiseCollationTables;

packages/fcl-db/src/dbase/dbf_common.inc

@@ -144,16 +144,9 @@
   {$define DELPHI_3}
 {$endif}
 
-{$ifdef VER190} // Delphi 2007
+{$ifdef VER185} // Delphi 2007
   {$define DELPHI_2007}
-  {$define DELPHI_2006}
-  {$define DELPHI_2005}
-  {$define DELPHI_8}
-  {$define DELPHI_7}
-  {$define DELPHI_6}
-  {$define DELPHI_5}
-  {$define DELPHI_4}
-  {$define DELPHI_3}
+  { Delphi 2007 also defines VER180, so other DELPHI defines already done }
 {$endif}
 
 //-------------------------------------------------------
@@ -186,6 +179,7 @@
 
   {$define SUPPORT_BACKWARD_FIELDDATA}
   {$define SUPPORT_INITDEFSFROMFIELDS}
+  {$define SUPPORT_REFRESHEVENTS}
   {$define SUPPORT_DEF_DELETE}
   {$define SUPPORT_FREEANDNIL}
 
@@ -227,6 +221,7 @@
   {$define SUPPORT_MATH_UNIT}
   {$define SUPPORT_VARIANTS}
   {$define SUPPORT_SEPARATE_VARIANTS_UNIT}
+  {$define SUPPORT_REFRESHEVENTS}
 
   // FPC 2.0.x improvements
   {$ifdef VER2}

packages/fcl-db/src/dbase/dbf_common.pas

@@ -18,7 +18,7 @@ uses
 const
   TDBF_MAJOR_VERSION      = 6;
   TDBF_MINOR_VERSION      = 9;
-  TDBF_SUB_MINOR_VERSION  = 1;
+  TDBF_SUB_MINOR_VERSION  = 2;
 
   TDBF_TABLELEVEL_FOXPRO = 25;
 

packages/fcl-db/src/dbase/dbf_cursor.pas

@@ -18,11 +18,11 @@ type
     FFile: TPagedFile;
 
   protected
-    function GetPhysicalRecno: Integer; virtual; abstract;
-    function GetSequentialRecno: Integer; virtual; abstract;
+    function GetPhysicalRecNo: Integer; virtual; abstract;
+    function GetSequentialRecNo: Integer; virtual; abstract;
     function GetSequentialRecordCount: Integer; virtual; abstract;
-    procedure SetPhysicalRecno(Recno: Integer); virtual; abstract;
-    procedure SetSequentialRecno(Recno: Integer); virtual; abstract;
+    procedure SetPhysicalRecNo(RecNo: Integer); virtual; abstract;
+    procedure SetSequentialRecNo(RecNo: Integer); virtual; abstract;
 
   public
     constructor Create(pFile: TPagedFile);

packages/fcl-db/src/dbase/dbf_idxcur.pas

@@ -10,6 +10,9 @@ uses
   dbf_cursor,
   dbf_idxfile,
   dbf_prsdef,
+{$ifndef WINDOWS}
+  dbf_wtil,
+{$endif}
   dbf_common;
 
 type
@@ -27,6 +30,7 @@ type
     procedure SetPhysicalRecNo(RecNo: Integer); override;
     procedure SetSequentialRecNo(RecNo: Integer); override;
 
+    procedure VariantStrToBuffer(Key: Variant; ABuffer: PChar);
   public
     constructor Create(DbfIndexFile: TIndexFile);
     destructor Destroy; override;
@@ -55,6 +59,11 @@ type
 //====================================================================
 implementation
 
+{$ifdef WINDOWS}
+uses
+  Windows;
+{$endif}
+
 //==========================================================
 //============ TIndexCursor
 //==========================================================
@@ -128,10 +137,19 @@ end;
 
 {$ifdef SUPPORT_VARIANTS}
 
-function TIndexCursor.VariantToBuffer(Key: Variant; ABuffer: PChar): TExpressionType;
-// assumes ABuffer is large enough ie. at least max key size
+procedure TIndexCursor.VariantStrToBuffer(Key: Variant; ABuffer: PChar);
 var
   currLen: Integer;
+  StrKey: string;
+begin
+  StrKey := Key;
+  currLen := TranslateString(GetACP, FIndexFile.CodePage, PChar(StrKey), ABuffer, -1);
+  // we have null-terminated string, pad with spaces if string too short
+  FillChar(ABuffer[currLen], TIndexFile(PagedFile).KeyLen-currLen, ' ');
+end;
+
+function TIndexCursor.VariantToBuffer(Key: Variant; ABuffer: PChar): TExpressionType;
+// assumes ABuffer is large enough ie. at least max key size
 begin
   if (TIndexFile(PagedFile).KeyType='N') then
   begin
@@ -143,10 +161,7 @@ begin
     end;
     Result := etInteger;
   end else begin
-    StrPLCopy(ABuffer, Key, TIndexFile(PagedFile).KeyLen);
-    // we have null-terminated string, pad with spaces if string too short
-    currLen := StrLen(ABuffer);
-    FillChar(ABuffer[currLen], TIndexFile(PagedFile).KeyLen-currLen, ' ');
+    VariantStrToBuffer(Key, ABuffer);
     Result := etString;
   end;
 end;

packages/fcl-db/src/dbase/dbf_idxfile.pas

@@ -409,6 +409,7 @@ uses
   dbf_fields,
   dbf_str,
   dbf_prssupp,
+  dbf_prscore,
   dbf_lang;
 
 const
@@ -1717,9 +1718,32 @@ end;
 { TDbfIndexParser }
 
 procedure TDbfIndexParser.ValidateExpression(AExpression: string);
+const
+  AnsiStrFuncs: array[0..13] of TExprFunc = (FuncUppercase, FuncLowercase, FuncStrI_EQ,
+    FuncStrIP_EQ, FuncStrI_NEQ, FuncStrI_LT, FuncStrI_GT, FuncStrI_LTE, FuncStrI_GTE,
+    FuncStrP_EQ, FuncStr_LT, FuncStr_GT, FuncStr_LTE, FuncStr_GTE);
+  AnsiFuncsToMode: array[boolean] of TStringFieldMode = (smRaw, smAnsi);
 var
+  TempRec: PExpressionRec;
   TempBuffer: pchar;
+  I: integer;
+  hasAnsiFuncs: boolean;
 begin
+  TempRec := CurrentRec;
+  hasAnsiFuncs := false;
+  while not hasAnsiFuncs and (TempRec <> nil) do
+  begin
+    for I := Low(AnsiStrFuncs) to High(AnsiStrFuncs) do
+      if @TempRec^.Oper = @AnsiStrFuncs[I] then
+      begin
+        hasAnsiFuncs := true;
+        break;
+      end;
+    TempRec := TempRec^.Next;
+  end;
+
+  StringFieldMode := AnsiFuncsToMode[hasAnsiFuncs];
+
   FResultLen := inherited ResultLen;
 
   if FResultLen = -1 then
@@ -2980,7 +3004,7 @@ function TIndexFile.ExtractKeyFromBuffer(Buffer: PChar): PChar;
 begin
   // execute expression to get key
   Result := PrepareKey(FCurrentParser.ExtractFromBuffer(Buffer), FCurrentParser.ResultType);
-  if not FCurrentParser.RawStringFields then
+  if FCurrentParser.StringFieldMode <> smRaw then
     TranslateString(GetACP, FCodePage, Result, Result, KeyLen);
 end;
 

packages/fcl-db/src/dbase/dbf_parser.pas

@@ -22,6 +22,8 @@ uses
 
 type
 
+  TStringFieldMode = (smRaw, smAnsi, smAnsiTrim);
+
   TDbfParser = class(TCustomExpressionParser)
   private
     FDbfFile: Pointer;
@@ -29,7 +31,7 @@ type
     FIsExpression: Boolean;       // expression or simple field?
     FFieldType: TExpressionType;
     FCaseInsensitive: Boolean;
-    FRawStringFields: Boolean;
+    FStringFieldMode: TStringFieldMode;
     FPartialMatch: boolean;
 
   protected
@@ -44,7 +46,7 @@ type
     function  GetResultLen: Integer;
 
     procedure SetCaseInsensitive(NewInsensitive: Boolean);
-    procedure SetRawStringFields(NewRawFields: Boolean);
+    procedure SetStringFieldMode(NewMode: TStringFieldMode);
     procedure SetPartialMatch(NewPartialMatch: boolean);
   public
     constructor Create(ADbfFile: Pointer);
@@ -60,7 +62,7 @@ type
     property ResultLen: Integer read GetResultLen;
 
     property CaseInsensitive: Boolean read FCaseInsensitive write SetCaseInsensitive;
-    property RawStringFields: Boolean read FRawStringFields write SetRawStringFields;
+    property StringFieldMode: TStringFieldMode read FStringFieldMode write SetStringFieldMode;
     property PartialMatch: boolean read FPartialMatch write SetPartialMatch;
   end;
 
@@ -106,20 +108,19 @@ type
   TStringFieldVar = class(TFieldVar)
   protected
     FFieldVal: PChar;
-    FRawStringField: boolean;
+    FMode: TStringFieldMode;
 
     function GetFieldVal: Pointer; override;
     function GetFieldType: TExpressionType; override;
     procedure SetExprWord(NewExprWord: TExprWord); override;
-    procedure SetRawStringField(NewRaw: boolean);
+    procedure SetMode(NewMode: TStringFieldMode);
     procedure UpdateExprWord;
   public
-    constructor Create(UseFieldDef: TDbfFieldDef; ADbfFile: TDbfFile);
     destructor Destroy; override;
 
     procedure Refresh(Buffer: PChar); override;
 
-    property RawStringField: boolean read FRawStringField write SetRawStringField;
+    property Mode: TStringFieldMode read FMode write SetMode;
   end;
 
   TFloatFieldVar = class(TFieldVar)
@@ -193,15 +194,9 @@ end;
 
 { TStringFieldVar }
 
-constructor TStringFieldVar.Create(UseFieldDef: TDbfFieldDef; ADbfFile: TDbfFile);
-begin
-  inherited;
-  FRawStringField := true;
-end;
-
 destructor TStringFieldVar.Destroy;
 begin
-  if not FRawStringField then
+  if FMode <> smRaw then
     FreeMem(FFieldVal);
 
   inherited;
@@ -223,11 +218,12 @@ var
   Src: PChar;
 begin
   Src := Buffer+FieldDef.Offset;
-  if not FRawStringField then
+  if FMode <> smRaw then
   begin
     // copy field data
     Len := FieldDef.Size;
-    while (Len >= 1) and (Src[Len-1] = ' ') do Dec(Len);
+    if FMode = smAnsiTrim then
+      while (Len >= 1) and (Src[Len-1] = ' ') do Dec(Len);
     // translate to ANSI
     Len := TranslateString(DbfFile.UseCodePage, GetACP, Src, FFieldVal, Len);
     FFieldVal[Len] := #0;
@@ -243,19 +239,21 @@ end;
 
 procedure TStringFieldVar.UpdateExprWord;
 begin
-  if FRawStringField then
+  if FMode <> smAnsiTrim then
     FExprWord.FixedLen := FieldDef.Size
   else
     FExprWord.FixedLen := -1;
 end;
 
-procedure TStringFieldVar.SetRawStringField(NewRaw: boolean);
+procedure TStringFieldVar.SetMode(NewMode: TStringFieldMode);
 begin
-  if NewRaw = FRawStringField then exit;
-  FRawStringField := NewRaw;
-  if NewRaw then
-    FreeMem(FFieldVal)
-  else
+  if NewMode = FMode then exit;
+  FMode := NewMode;
+  if NewMode = smRaw then
+  begin
+    FreeMem(FFieldVal);
+    FFieldVal := nil;
+  end else
     GetMem(FFieldVal, FieldDef.Size*3+1);
   UpdateExprWord;
 end;
@@ -361,7 +359,6 @@ begin
   FDbfFile := ADbfFile;
   FFieldVarList := TStringList.Create;
   FCaseInsensitive := true;
-  FRawStringFields := true;
   inherited Create;
 end;
 
@@ -391,7 +388,7 @@ begin
     etDateTime: Result := 8;
     etString:
     begin
-      if not FIsExpression and (TStringFieldVar(FFieldVarList.Objects[0]).RawStringField) then
+      if not FIsExpression and (TStringFieldVar(FFieldVarList.Objects[0]).Mode <> smAnsiTrim) then
         Result := TStringFieldVar(FFieldVarList.Objects[0]).FieldDef.Size
       else
         Result := -1;
@@ -421,17 +418,17 @@ begin
   end;
 end;
 
-procedure TDbfParser.SetRawStringFields(NewRawFields: Boolean);
+procedure TDbfParser.SetStringFieldMode(NewMode: TStringFieldMode);
 var
   I: integer;
 begin
-  if FRawStringFields <> NewRawFields then
+  if FStringFieldMode <> NewMode then
   begin
     // clear and regenerate functions, custom fields will be deleted too
-    FRawStringFields := NewRawFields;
+    FStringFieldMode := NewMode;
     for I := 0 to FFieldVarList.Count - 1 do
       if FFieldVarList.Objects[I] is TStringFieldVar then
-        TStringFieldVar(FFieldVarList.Objects[I]).RawStringField := NewRawFields;
+        TStringFieldVar(FFieldVarList.Objects[I]).Mode := NewMode;
   end;
 end;
 
@@ -486,7 +483,7 @@ begin
       begin
         TempFieldVar := TStringFieldVar.Create(FieldInfo, TDbfFile(FDbfFile));
         TempFieldVar.ExprWord := DefineStringVariable(VarName, TempFieldVar.FieldVal);
-        TStringFieldVar(TempFieldVar).RawStringField := FRawStringFields;
+        TStringFieldVar(TempFieldVar).Mode := FStringFieldMode;
       end;
     ftBoolean:
       begin

packages/fcl-db/src/dbase/dbf_prscore.pas

@@ -174,6 +174,8 @@ procedure FuncStrI_LT(Param: PExpressionRec);
 procedure FuncStrI_GT(Param: PExpressionRec);
 procedure FuncStrI_LTE(Param: PExpressionRec);
 procedure FuncStrI_GTE(Param: PExpressionRec);
+procedure FuncStrIP_EQ(Param: PExpressionRec);
+procedure FuncStrP_EQ(Param: PExpressionRec);
 procedure FuncStr_EQ(Param: PExpressionRec);
 procedure FuncStr_NEQ(Param: PExpressionRec);
 procedure FuncStr_LT(Param: PExpressionRec);

packages/fcl-db/src/dbase/dbf_prsdef.pas

@@ -26,6 +26,7 @@ type
   PExpressionRec = ^TExpressionRec;
   PDynamicType = ^TDynamicType;
   PDateTimeRec = ^TDateTimeRec;
+  PDouble = ^Double;
 {$ifdef SUPPORT_INT64}
   PLargeInt = ^Int64;
 {$endif}

packages/fcl-db/src/dbase/history.txt

@@ -32,6 +32,14 @@ BUGS & WARNINGS
 
 
 
+------------------------
+V6.9.2
+
+- compile fixes for delphi 4, 5 (pdouble)
+- fix indexes to work properly with ansi upper/lower casing
+- fix memory leak when inserting duplicate item in AVL tree 
+- add german localization strings (thx heiko)
+
 ------------------------
 V6.9.1
 

packages/fcl-db/src/dbconst.pas

@@ -39,6 +39,7 @@ Resourcestring
   SErrIndexBasedOnInvField = 'Field "%s" is an invalid field type to base index on.';
   SErrIndexBasedOnUnkField = 'Index based on unknown field "%s".';
   SErrConnTransactionnSet  = 'Transaction of connection not set';
+  SErrNotASQLConnection    = '"%s" is not a TSQLConnection';
   STransNotActive          = 'Operation cannot be performed on an inactive transaction';
   STransActive             = 'Operation cannot be performed on an active transaction';
   SFieldNotFound           = 'Field not found : "%s"';
@@ -95,6 +96,7 @@ Resourcestring
   SNoFieldIndexes          = 'No index currently active';
   SNotIndexField           = 'Field ''%s'' is not indexed and cannot be modified';
   SErrUnknownConnectorType = 'Unknown connector type';
+  SErrAmountStrings        = 'Amount of search and replace strings don''t match';
   SErrCircularDataSourceReferenceNotAllowed = 'Circular datasource references are not allowed.';
   
 

packages/fcl-db/src/dsparams.inc

@@ -296,7 +296,7 @@ begin
             else
             begin
               ParamNameStart:=p;
-              while not (p^ in (SQLDelimiterCharacters+[#0])) do
+              while not (p^ in (SQLDelimiterCharacters+[#0,'=','+','-','*','\','/','[',']'])) do
                 Inc(p);
               ParamName:=Copy(ParamNameStart,1,p-ParamNameStart);
             end;

packages/fcl-db/src/fields.inc

@@ -950,13 +950,16 @@ begin
   SetDataType(ftString);
   FFixedChar := False;
   FTransliterate := False;
-  Size:=20;
+  FSize:=20;
 end;
 
 class procedure TStringField.CheckTypeSize(AValue: Longint);
 
 begin
-  If (AValue<1) or (AValue>dsMaxStringSize) Then
+// A size of 0 is allowed, since for example Firebird allows
+// a query like: 'select '' as fieldname from table' which
+// results in a string with size 0.
+  If (AValue<0) or (AValue>dsMaxStringSize) Then
     databaseErrorFmt(SInvalidFieldSize,[AValue])
 end;
 
@@ -1082,6 +1085,7 @@ begin
   else if FTransliterate then
     begin
     DataSet.Translate(@AValue[1],Buf,True);
+    Buf[DataSize-1] := #0;
     SetData(@buf);
     end
   else
@@ -1089,6 +1093,8 @@ begin
     // The data is copied into the buffer, since some TDataset descendents copy
     // the whole buffer-length in SetData. (See bug 8477)
     Buf := AValue;
+    // If length(AValue) > Datasize the buffer isn't terminated properly
+    Buf[DataSize-1] := #0;
     SetData(@Buf);
     end;
 end;

packages/fcl-db/src/sqldb/interbase/ibconnection.pp

@@ -14,6 +14,9 @@ uses
   ibase60;
 {$EndIf}
 
+const
+  DEFDIALECT = 3;
+
 type
 
   EIBDatabaseError = class(EDatabaseError)
@@ -47,24 +50,26 @@ type
     FSQLDatabaseHandle   : pointer;
     FStatus              : array [0..19] of ISC_STATUS;
     FDialect             : integer;
+    FDBDialect           : integer;
     FBLobSegmentSize     : word;
 
     procedure ConnectFB;
     function GetDialect: integer;
-    procedure SetDBDialect;
     procedure AllocSQLDA(var aSQLDA : PXSQLDA;Count : integer);
-    procedure TranslateFldType(SQLType, SQLLen, SQLScale : integer; var LensSet : boolean;
+    procedure TranslateFldType(SQLType, SQLLen, SQLScale : integer;
       var TrType : TFieldType; var TrLen : word);
     // conversion methods
     procedure GetDateTime(CurrBuff, Buffer : pointer; AType : integer);
     procedure SetDateTime(CurrBuff: pointer; PTime : TDateTime; AType : integer);
-    procedure GetFloat(CurrBuff, Buffer : pointer; Field : TFieldDef);
+    procedure GetFloat(CurrBuff, Buffer : pointer; Size : Byte);
     procedure SetFloat(CurrBuff: pointer; Dbl: Double; Size: integer);
     procedure CheckError(ProcName : string; Status : PISC_STATUS);
     function getMaxBlobSize(blobHandle : TIsc_Blob_Handle) : longInt;
     procedure SetParameters(cursor : TSQLCursor;AParams : TParams);
     procedure FreeSQLDABuffer(var aSQLDA : PXSQLDA);
+    function  IsDialectStored: boolean;
   protected
+    procedure DoConnect; override;
     procedure DoInternalConnect; override;
     procedure DoInternalDisconnect; override;
     function GetHandle : pointer; override;
@@ -89,14 +94,16 @@ type
     procedure UpdateIndexDefs(var IndexDefs : TIndexDefs;TableName : string); override;
     function GetSchemaInfoSQL(SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string; override;
     procedure LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction : TSQLTransaction); override;
+    function RowsAffected(cursor: TSQLCursor): TRowsCount; override;
   public
     constructor Create(AOwner : TComponent); override;
     procedure CreateDB; override;
     procedure DropDB; override;
     property BlobSegmentSize : word read FBlobSegmentSize write FBlobSegmentSize;
+    function GetDBDialect: integer;
   published
-    property Dialect  : integer read GetDialect write FDialect;
     property DatabaseName;
+    property Dialect : integer read GetDialect write FDialect stored IsDialectStored default DEFDIALECT;
     property KeepConnection;
     property LoginPrompt;
     property Params;
@@ -132,18 +139,20 @@ type
 
 procedure TIBConnection.CheckError(ProcName : string; Status : PISC_STATUS);
 var
-  buf : array [0..1024] of char;
+  buf : array [0..1023] of char;
   Msg : string;
   E   : EIBDatabaseError;
+  Err : longint;
   
 begin
   if ((Status[0] = 1) and (Status[1] <> 0)) then
   begin
+    Err := Status[1];
     msg := '';
     while isc_interprete(Buf, @Status) > 0 do
       Msg := Msg + LineEnding +' -' + StrPas(Buf);
     E := EIBDatabaseError.CreateFmt('%s : %s : %s',[self.Name,ProcName,Msg]);
-    E.GDSErrorCode := Status[1];
+    E.GDSErrorCode := Err;
     Raise E;
   end;
 end;
@@ -156,6 +165,7 @@ begin
   FConnOptions := FConnOptions + [sqSupportParams] + [sqEscapeRepeat];
   FBLobSegmentSize := 80;
   FDialect := -1;
+  FDBDialect := -1;
 end;
 
 
@@ -308,6 +318,7 @@ end;
 procedure TIBConnection.DoInternalDisconnect;
 begin
   FDialect := -1;
+  FDBDialect := -1;
   if not Connected then
   begin
     FSQLDatabaseHandle := nil;
@@ -322,32 +333,36 @@ begin
 end;
 
 
-procedure TIBConnection.SetDBDialect;
+function TIBConnection.GetDBDialect: integer;
 var
   x : integer;
   Len : integer;
   Buffer : array [0..1] of byte;
   ResBuf : array [0..39] of byte;
 begin
-  Buffer[0] := isc_info_db_sql_dialect;
-  Buffer[1] := isc_info_end;
-  if isc_database_info(@FStatus[0], @FSQLDatabaseHandle, Length(Buffer),
-    pchar(@Buffer[0]), SizeOf(ResBuf), pchar(@ResBuf[0])) <> 0 then
-      CheckError('SetDBDialect', FStatus);
-  x := 0;
-  while x < 40 do
-    case ResBuf[x] of
-      isc_info_db_sql_dialect :
-        begin
-        Inc(x);
-        Len := isc_vax_integer(pchar(@ResBuf[x]), 2);
-        Inc(x, 2);
-        FDialect := isc_vax_integer(pchar(@ResBuf[x]), Len);
-        Inc(x, Len);
-        end;
-      isc_info_end : Break;
-    else
-      inc(x);
+  result := -1;
+  if Connected then
+    begin
+    Buffer[0] := isc_info_db_sql_dialect;
+    Buffer[1] := isc_info_end;
+    if isc_database_info(@FStatus[0], @FSQLDatabaseHandle, Length(Buffer),
+      pchar(@Buffer[0]), SizeOf(ResBuf), pchar(@ResBuf[0])) <> 0 then
+        CheckError('SetDBDialect', FStatus);
+    x := 0;
+    while x < 40 do
+      case ResBuf[x] of
+        isc_info_db_sql_dialect :
+          begin
+          Inc(x);
+          Len := isc_vax_integer(pchar(@ResBuf[x]), 2);
+          Inc(x, 2);
+          Result := isc_vax_integer(pchar(@ResBuf[x]), Len);
+          Inc(x, Len);
+          end;
+        isc_info_end : Break;
+      else
+        inc(x);
+      end;
     end;
 end;
 
@@ -380,8 +395,13 @@ end;
 function TIBConnection.GetDialect: integer;
 begin
   if FDialect = -1 then
-    SetDBDialect;
-  Result := FDialect;
+  begin
+    if FDBDialect = -1 then
+      Result := DEFDIALECT
+    else
+      Result := FDBDialect;
+  end else
+    Result := FDialect;
 end;
 
 procedure TIBConnection.AllocSQLDA(var aSQLDA : PXSQLDA;Count : integer);
@@ -403,34 +423,28 @@ begin
     reAllocMem(aSQLDA,0);
 end;
 
-procedure TIBConnection.TranslateFldType(SQLType, SQLLen, SQLScale : integer; var LensSet : boolean;
-  var TrType : TFieldType; var TrLen : word);
+procedure TIBConnection.TranslateFldType(SQLType, SQLLen, SQLScale : integer;
+           var TrType : TFieldType; var TrLen : word);
 begin
-  LensSet := False;
-
+  trlen := 0;
   if SQLScale < 0 then
     begin
     if (SQLScale >= -4) and (SQLScale <= -1) then //in [-4..-1] then
       begin
-      LensSet := True;
-      TrLen := SQLLen;
+      TrLen := abs(SQLScale);
       TrType := ftBCD
       end
     else
       TrType := ftFMTBcd;
     end
   else case (SQLType and not 1) of
-    SQL_VARYING :
+    SQL_VARYING,SQL_TEXT :
       begin
-        LensSet := True;
         TrType := ftString;
-        TrLen := SQLLen;
-      end;
-    SQL_TEXT :
-      begin
-        LensSet := True;
-        TrType := ftString;
-        TrLen := SQLLen;
+        if SQLLen > dsMaxStringSize then
+          TrLen := dsMaxStringSize
+        else
+          TrLen := SQLLen;
       end;
     SQL_TYPE_DATE :
       TrType := ftDate{Time};
@@ -441,43 +455,25 @@ begin
     SQL_ARRAY :
       begin
         TrType := ftArray;
-        LensSet := true;
         TrLen := SQLLen;
       end;
     SQL_BLOB :
       begin
-          TrType := ftBlob;
-          LensSet := True;
-          TrLen := SQLLen;
+        TrType := ftBlob;
+        TrLen := SQLLen;
       end;
     SQL_SHORT :
         TrType := ftSmallint;
     SQL_LONG :
-      begin
-        LensSet := True;
-        TrLen := 0;
         TrType := ftInteger;
-      end;
     SQL_INT64 :
         TrType := ftLargeInt;
     SQL_DOUBLE :
-      begin
-        LensSet := True;
-        TrLen := SQLLen;
         TrType := ftFloat;
-      end;
     SQL_FLOAT :
-      begin
-        LensSet := True;
-        TrLen := SQLLen;
         TrType := ftFloat;
-      end
     else
-      begin
-        LensSet := True;
-        TrLen := 0;
         TrType := ftUnknown;
-      end;
   end;
 end;
 
@@ -608,6 +604,17 @@ begin
 {$R+}
 end;
 
+function TIBConnection.IsDialectStored: boolean;
+begin
+  result := (FDialect<>-1);
+end;
+
+procedure TIBConnection.DoConnect;
+begin
+  inherited DoConnect;
+  FDbDialect := GetDBDialect;
+end;
+
 procedure TIBConnection.FreeFldBuffers(cursor : TSQLCursor);
 
 begin
@@ -633,7 +640,6 @@ end;
 procedure TIBConnection.AddFieldDefs(cursor: TSQLCursor;FieldDefs : TfieldDefs);
 var
   x         : integer;
-  lenset    : boolean;
   TransLen  : word;
   TransType : TFieldType;
   FD        : TFieldDef;
@@ -646,7 +652,7 @@ begin
     for x := 0 to SQLDA^.SQLD - 1 do
       begin
       TranslateFldType(SQLDA^.SQLVar[x].SQLType, SQLDA^.SQLVar[x].SQLLen, SQLDA^.SQLVar[x].SQLScale,
-        lenset, TransType, TransLen);
+        TransType, TransLen);
       FD := TFieldDef.Create(FieldDefs, SQLDA^.SQLVar[x].AliasName, TransType,
          TransLen, False, (x + 1));
       if TransType = ftBCD then FD.precision := SQLDA^.SQLVar[x].SQLLen;
@@ -814,12 +820,14 @@ begin
         if ((SQLType and not 1) = SQL_VARYING) then
           begin
           Move(SQLData^, VarcharLen, 2);
+          if VarcharLen > dsMaxStringSize then
+            VarcharLen:=dsMaxStringSize;
           CurrBuff := SQLData + 2;
           end
         else
           begin
           CurrBuff := SQLData;
-          VarCharLen := SQLDA^.SQLVar[x].SQLLen;
+          VarCharLen := FieldDef.Size;
           end;
 
       Result := true;
@@ -850,11 +858,11 @@ begin
           GetDateTime(CurrBuff, Buffer, SQLDA^.SQLVar[x].SQLType);
         ftString  :
           begin
-            Move(CurrBuff^, Buffer^, SQLDA^.SQLVar[x].SQLLen);
+            Move(CurrBuff^, Buffer^, VarCharLen);
             PChar(Buffer + VarCharLen)^ := #0;
           end;
         ftFloat   :
-          GetFloat(CurrBuff, Buffer, FieldDef);
+          GetFloat(CurrBuff, Buffer, SQLDA^.SQLVar[x].SQLLen);
         ftBlob : begin  // load the BlobIb in field's buffer
             FillByte(buffer^,sizeof(TBufBlobField),0);
             Move(CurrBuff^, Buffer^, SQLDA^.SQLVar[x].SQLLen);
@@ -927,7 +935,7 @@ begin
     stTables     : s := 'select '+
                           'rdb$relation_id          as recno, '+
                           '''' + DatabaseName + ''' as catalog_name, '+
-                          '''''                     as schema_name, '+
+                          'cast ('''' as varchar(32)) as schema_name, '+
                           'rdb$relation_name        as table_name, '+
                           '0                        as table_type '+
                         'from '+
@@ -939,7 +947,7 @@ begin
     stSysTables  : s := 'select '+
                           'rdb$relation_id          as recno, '+
                           '''' + DatabaseName + ''' as catalog_name, '+
-                          '''''                     as schema_name, '+
+                          'cast ('''' as varchar(32)) as schema_name, '+
                           'rdb$relation_name        as table_name, '+
                           '0                        as table_type '+
                         'from '+
@@ -951,7 +959,7 @@ begin
     stProcedures : s := 'select '+
                            'rdb$procedure_id        as recno, '+
                           '''' + DatabaseName + ''' as catalog_name, '+
-                          '''''                     as schema_name, '+
+                          'cast ('''' as varchar(32)) as schema_name, '+
                           'rdb$procedure_name       as proc_name, '+
                           '0                        as proc_type, '+
                           'rdb$procedure_inputs     as in_params, '+
@@ -963,13 +971,13 @@ begin
     stColumns    : s := 'select '+
                            'rdb$field_id            as recno, '+
                           '''' + DatabaseName + ''' as catalog_name, '+
-                          '''''                     as schema_name, '+
+                          'cast ('''' as varchar(32)) as schema_name, '+
                           'rdb$relation_name        as table_name, '+
                           'rdb$field_name           as column_name, '+
                           'rdb$field_position       as column_position, '+
                           '0                        as column_type, '+
                           '0                        as column_datatype, '+
-                          '''''                     as column_typename, '+
+                          'cast ('''' as varchar(32)) as column_typename, '+
                           '0                        as column_subtype, '+
                           '0                        as column_precision, '+
                           '0                        as column_scale, '+
@@ -1066,13 +1074,13 @@ begin
   end;
 end;
 
-procedure TIBConnection.GetFloat(CurrBuff, Buffer : pointer; Field : TFieldDef);
+procedure TIBConnection.GetFloat(CurrBuff, Buffer : pointer; Size : byte);
 var
   Ext : extended;
   Dbl : double;
   Sin : single;
 begin
-  case Field.Size of
+  case Size of
     4 :
       begin
         Move(CurrBuff^, Sin, 4);
@@ -1155,6 +1163,53 @@ begin
     CheckError('TIBConnection.CreateBlobStream isc_get_segment', FStatus);
 end;
 
+function TIBConnection.RowsAffected(cursor: TSQLCursor): TRowsCount;
+
+var info_request       : string;
+    resbuf             : array[0..63] of byte;
+    i                  : integer;
+    BlockSize,
+    subBlockSize       : integer;
+    SelectedRows,
+    InsertedRows       : integer;
+    
+begin
+  SelectedRows:=-1;
+  InsertedRows:=-1;
+
+  if assigned(cursor) then with cursor as TIBCursor do
+   if assigned(statement) then
+    begin
+    info_request := chr(isc_info_sql_records);
+    if isc_dsql_sql_info(@Status[0],@Statement,Length(info_request), @info_request[1],sizeof(resbuf),@resbuf) <> 0 then
+      CheckError('RowsAffected', Status);
+
+    i := 0;
+    while not (byte(resbuf[i]) in [isc_info_end,isc_info_truncated]) do
+      begin
+      BlockSize:=isc_vax_integer(@resbuf[i+1],2);
+      if resbuf[i]=isc_info_sql_records then
+        begin
+        inc(i,3);
+        BlockSize:=BlockSize+i;
+        while (resbuf[i] <> isc_info_end) and (i < BlockSize) do
+          begin
+          subBlockSize:=isc_vax_integer(@resbuf[i+1],2);
+          if resbuf[i] = isc_info_req_select_count then
+            SelectedRows := isc_vax_integer(@resbuf[i+3],subBlockSize)
+          else if resbuf[i] = isc_info_req_insert_count then
+            InsertedRows := isc_vax_integer(@resbuf[i+3],subBlockSize);
+          inc(i,subBlockSize+3);
+          end;
+        end
+      else
+        inc(i,BlockSize+3);
+      end;
+    end;
+  if SelectedRows>0 then result:=SelectedRows
+  else Result:=InsertedRows;
+end;
+
 { TIBConnectionDef }
 
 class function TIBConnectionDef.TypeName: String;

packages/fcl-db/src/sqldb/mysql/mysqlconn.inc

@@ -115,6 +115,7 @@ Type
     procedure CommitRetaining(trans : TSQLHandle); override;
     procedure RollBackRetaining(trans : TSQLHandle); override;
     procedure UpdateIndexDefs(var IndexDefs : TIndexDefs;TableName : string); override;
+    function RowsAffected(cursor: TSQLCursor): TRowsCount; override;
   Public
     constructor Create(AOwner : TComponent); override;
     procedure CreateDB; override;
@@ -402,14 +403,24 @@ procedure TConnectionName.Execute(cursor: TSQLCursor;
 Var
   C : TCursorName;
   i : integer;
+  ParamNames,ParamValues : array of string;
 
 begin
   C:=Cursor as TCursorName;
   If (C.FRes=Nil) then
     begin
     if Assigned(AParams) and (AParams.count > 0) then
+      begin
+      setlength(ParamNames,AParams.Count);
+      setlength(ParamValues,AParams.Count);
       for i := 0 to AParams.count -1 do
-        C.FStatement := stringreplace(C.FStatement,C.ParamReplaceString+inttostr(AParams[i].Index+1),GetAsSQLText(AParams[i]),[rfReplaceAll,rfIgnoreCase]);
+        begin
+        ParamNames[AParams.count-i-1] := C.ParamReplaceString+inttostr(AParams[i].Index+1);
+        ParamValues[AParams.count-i-1] := GetAsSQLText(AParams[i]);
+        end;
+      // paramreplacestring kan een probleem geven bij postgres als hij niet meer gewoon $ is?
+      C.FStatement := stringsreplace(C.FStatement,ParamNames,ParamValues,[rfReplaceAll]);
+      end;
     if mysql_query(FMySQL,Pchar(C.FStatement))<>0 then
       MySQLError(FMYSQL,Format(SErrExecuting,[StrPas(mysql_error(FMySQL))]),Self)
     else
@@ -834,6 +845,11 @@ begin
   qry.free;
 end;
 
+function TConnectionName.RowsAffected(cursor: TSQLCursor): TRowsCount;
+begin
+  Result := (cursor as TCursorName).RowsAffected;
+end;
+
 constructor TConnectionName.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);

packages/fcl-db/src/sqldb/postgres/pqconnection.pp

@@ -39,7 +39,7 @@ type
     FConnectString       : string;
     FSQLDatabaseHandle   : pointer;
     FIntegerDateTimes    : boolean;
-    function TranslateFldType(Type_Oid : integer) : TFieldType;
+    function TranslateFldType(res : PPGresult; Tuple : integer; var Size : integer) : TFieldType;
     procedure ExecuteDirectPG(const Query : String);
   protected
     procedure DoInternalConnect; override;
@@ -65,6 +65,7 @@ type
     procedure UpdateIndexDefs(var IndexDefs : TIndexDefs;TableName : string); override;
     function GetSchemaInfoSQL(SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string; override;
     procedure LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField; cursor: TSQLCursor;ATransaction : TSQLTransaction); override;
+    function RowsAffected(cursor: TSQLCursor): TRowsCount; override;
   public
     constructor Create(AOwner : TComponent); override;
     procedure CreateDB; override;
@@ -109,6 +110,7 @@ const Oid_Bool     = 16;
       Oid_int2     = 21;
       Oid_Int4     = 23;
       Oid_Float4   = 700;
+      Oid_Money    = 790;
       Oid_Float8   = 701;
       Oid_Unknown  = 705;
       Oid_bpchar   = 1042;
@@ -374,12 +376,22 @@ begin
 
 end;
 
-function TPQConnection.TranslateFldType(Type_Oid : integer) : TFieldType;
+function TPQConnection.TranslateFldType(res : PPGresult; Tuple : integer; var Size : integer) : TFieldType;
 
 begin
-  case Type_Oid of
+  Size := 0;
+  case PQftype(res,Tuple) of
     Oid_varchar,Oid_bpchar,
-    Oid_name               : Result := ftstring;
+    Oid_name               : begin
+                             Result := ftstring;
+                             size := PQfsize(Res, Tuple);
+                             if (size = -1) then
+                               begin
+                               size := pqfmod(res,Tuple)-4;
+                               if size = -5 then size := dsMaxStringSize;
+                               end;
+                             if size > dsMaxStringSize then size := dsMaxStringSize;
+                             end;
 //    Oid_text               : Result := ftstring;
     Oid_text               : Result := ftBlob;
     Oid_oid                : Result := ftInteger;
@@ -392,7 +404,15 @@ begin
     Oid_Date               : Result := ftDate;
     Oid_Time               : Result := ftTime;
     Oid_Bool               : Result := ftBoolean;
-    Oid_Numeric            : Result := ftBCD;
+    Oid_Numeric            : begin
+                             Result := ftBCD;
+                             size := PQfmod(res,Tuple);
+                             if size = -1 then
+                               size := 4
+                             else
+                               size := size -4;
+                             end;
+    Oid_Money              : Result := ftCurrency;
     Oid_Unknown            : Result := ftUnknown;
   else
     Result := ftUnknown;
@@ -532,6 +552,7 @@ procedure TPQConnection.Execute(cursor: TSQLCursor;atransaction:tSQLtransaction;
 var ar  : array of pchar;
     i   : integer;
     s   : string;
+    ParamNames,ParamValues : array of string;
 
 begin
   with cursor as TPQCursor do
@@ -565,10 +586,19 @@ begin
       begin
       tr := TPQTrans(aTransaction.Handle);
 
-      s := statement;
-      //Should be altered, just like in TSQLQuery.ApplyRecUpdate
-      if assigned(AParams) then for i := 0 to AParams.count-1 do
-        s := stringreplace(s,':'+AParams[i].Name,AParams[i].asstring,[rfReplaceAll,rfIgnoreCase]);
+      if Assigned(AParams) and (AParams.count > 0) then
+        begin
+        setlength(ParamNames,AParams.Count);
+        setlength(ParamValues,AParams.Count);
+        for i := 0 to AParams.count -1 do
+          begin
+          ParamNames[AParams.count-i-1] := '$'+inttostr(AParams[i].index+1);
+          ParamValues[AParams.count-i-1] := GetAsSQLText(AParams[i]);
+          end;
+        s := stringsreplace(statement,ParamNames,ParamValues,[rfReplaceAll]);
+        end
+      else
+        s := Statement;
       res := pqexec(tr.PGConn,pchar(s));
       end;
     if not (PQresultStatus(res) in [PGRES_COMMAND_OK,PGRES_TUPLES_OK]) then
@@ -600,19 +630,7 @@ begin
     setlength(FieldBinding,nFields);
     for i := 0 to nFields-1 do
       begin
-      size := PQfsize(Res, i);
-      fieldtype := TranslateFldType(PQftype(Res, i));
-
-      if (fieldtype = ftstring) and (size = -1) then
-        begin
-        size := pqfmod(res,i)-4;
-        if size = -5 then size := dsMaxStringSize;
-        end
-      else if fieldtype = ftdate  then
-        size := sizeof(double)
-      else if fieldtype = ftblob then
-        size := 0;
-
+      fieldtype := TranslateFldType(Res, i,size);
       with TFieldDef.Create(FieldDefs, PQfname(Res, i), fieldtype,size, False, (i + 1)) do
         FieldBinding[FieldNo-1] := i;
       end;
@@ -670,7 +688,6 @@ begin
       result := false
     else
       begin
-      i := PQfsize(res, x);
       CurrBuff := pqgetvalue(res,CurTuple,x);
 
       result := true;
@@ -678,6 +695,7 @@ begin
       case FieldDef.DataType of
         ftInteger, ftSmallint, ftLargeInt,ftfloat :
           begin
+          i := PQfsize(res, x);
           case i of               // postgres returns big-endian numbers
             sizeof(int64) : pint64(buffer)^ := BEtoN(pint64(CurrBuff)^);
             sizeof(integer) : pinteger(buffer)^ := BEtoN(pinteger(CurrBuff)^);
@@ -690,16 +708,15 @@ begin
         ftString  :
           begin
           li := pqgetlength(res,curtuple,x);
+          if li > dsMaxStringSize then li := dsMaxStringSize;
           Move(CurrBuff^, Buffer^, li);
           pchar(Buffer + li)^ := #0;
-          i := pqfmod(res,x)-3;
           end;
         ftBlob : Createblob := True;
         ftdate :
           begin
           dbl := pointer(buffer);
           dbl^ := BEtoN(plongint(CurrBuff)^) + 36526;
-          i := sizeof(double);
           end;
         ftDateTime, fttime :
           begin
@@ -733,6 +750,11 @@ begin
             Move(Cur, Buffer^, sizeof(currency));
             end;
           end;
+        ftCurrency  :
+          begin
+          dbl := pointer(buffer);
+          dbl^ := BEtoN(PInteger(CurrBuff)^) / 100;
+          end;
         ftBoolean:
           pchar(buffer)[0] := CurrBuff[0]
         else
@@ -851,6 +873,14 @@ begin
     end;
 end;
 
+function TPQConnection.RowsAffected(cursor: TSQLCursor): TRowsCount;
+begin
+  if assigned(cursor) and assigned((cursor as TPQCursor).res) then
+    Result := StrToIntDef(PQcmdTuples((cursor as TPQCursor).res),-1)
+  else
+    Result := -1;
+end;
+
 { TPQConnectionDef }
 
 class function TPQConnectionDef.TypeName: String;

packages/fcl-db/src/sqldb/sqldb.pp

@@ -26,6 +26,8 @@ type TSchemaType = (stNoSchema, stTables, stSysTables, stProcedures, stColumns,
      TConnOption = (sqSupportParams,sqEscapeSlash,sqEscapeRepeat);
      TConnOptions= set of TConnOption;
 
+     TRowsCount = LargeInt;
+
 type
   TSQLConnection = class;
   TSQLTransaction = class;
@@ -105,6 +107,7 @@ type
     procedure UpdateIndexDefs(var IndexDefs : TIndexDefs;TableName : string); virtual;
     function GetSchemaInfoSQL(SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string; virtual;
     procedure LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction : TSQLTransaction); virtual; abstract;
+    function RowsAffected(cursor: TSQLCursor): TRowsCount; virtual;
   public
     property Handle: Pointer read GetHandle;
     destructor Destroy; override;
@@ -241,6 +244,7 @@ type
     procedure SetSchemaInfo( SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string); virtual;
     property Prepared : boolean read IsPrepared;
     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+    function RowsAffected: TRowsCount; virtual;
   protected
       
     // redeclared data set properties
@@ -394,6 +398,7 @@ type
 
     procedure FreeFldBuffers(cursor : TSQLCursor); override;
     function LoadField(cursor : TSQLCursor;FieldDef : TfieldDef;buffer : pointer; out CreateBlob : boolean) : boolean; override;
+    function RowsAffected(cursor: TSQLCursor): TRowsCount; override;
     function GetTransactionHandle(trans : TSQLHandle): pointer; override;
     function Commit(trans : TSQLHandle) : boolean; override;
     function RollBack(trans : TSQLHandle) : boolean; override;
@@ -425,6 +430,7 @@ Procedure UnRegisterConnection(Def : TConnectionDefClass);
 Procedure UnRegisterConnection(ConnectionName : String);
 Function GetConnectionDef(ConnectorName : String) : TConnectionDef;
 Procedure GetConnectionList(List : TSTrings);
+function StringsReplace(const S: string; OldPattern, NewPattern: array of string;  Flags: TReplaceFlags): string;
 
 implementation
 
@@ -553,6 +559,10 @@ begin
   qry.free;
 end;
 
+function TSQLConnection.RowsAffected(cursor: TSQLCursor): TRowsCount;
+begin
+  Result := -1;
+end;
 
 procedure TSQLConnection.GetTableNames(List: TStrings; SystemTables: Boolean);
 begin
@@ -634,7 +644,7 @@ end;
 
 function TSQLTransaction.GetHandle: pointer;
 begin
-  Result := (Database as tsqlconnection).GetTransactionHandle(FTrans);
+  Result := TSQLConnection(Database).GetTransactionHandle(FTrans);
 end;
 
 procedure TSQLTransaction.Commit;
@@ -642,7 +652,7 @@ begin
   if active then
     begin
     closedatasets;
-    if (Database as tsqlconnection).commit(FTrans) then
+    if TSQLConnection(Database).commit(FTrans) then
       begin
       closeTrans;
       FreeAndNil(FTrans);
@@ -653,7 +663,7 @@ end;
 procedure TSQLTransaction.CommitRetaining;
 begin
   if active then
-    (Database as tsqlconnection).commitRetaining(FTrans);
+    TSQLConnection(Database).commitRetaining(FTrans);
 end;
 
 procedure TSQLTransaction.Rollback;
@@ -661,7 +671,7 @@ begin
   if active then
     begin
     closedatasets;
-    if (Database as tsqlconnection).RollBack(FTrans) then
+    if TSQLConnection(Database).RollBack(FTrans) then
       begin
       CloseTrans;
       FreeAndNil(FTrans);
@@ -672,7 +682,7 @@ end;
 procedure TSQLTransaction.RollbackRetaining;
 begin
   if active then
-    (Database as tsqlconnection).RollBackRetaining(FTrans);
+    TSQLConnection(Database).RollBackRetaining(FTrans);
 end;
 
 procedure TSQLTransaction.StartTransaction;
@@ -683,7 +693,7 @@ begin
   if Active then
     DatabaseError(SErrTransAlreadyActive);
 
-  db := (Database as tsqlconnection);
+  db := TSQLConnection(Database);
 
   if Db = nil then
     DatabaseError(SErrDatabasenAssigned);
@@ -713,9 +723,11 @@ Procedure TSQLTransaction.SetDatabase(Value : TDatabase);
 begin
   If Value<>Database then
     begin
+    if assigned(value) and not (Value is TSQLConnection) then
+      DatabaseErrorFmt(SErrNotASQLConnection,[value.Name],self);
     CheckInactive;
     If Assigned(Database) then
-      with Database as TSqlConnection do
+      with TSQLConnection(DataBase) do
         if Transaction = self then Transaction := nil;
     inherited SetDatabase(Value);
     end;
@@ -731,7 +743,7 @@ begin
   if (FSQL <> nil) then
     begin
     if assigned(DataBase) then
-      ConnOptions := (DataBase as TSQLConnection).ConnOptions
+      ConnOptions := TSQLConnection(DataBase).ConnOptions
     else
       ConnOptions := [sqEscapeRepeat,sqEscapeSlash];
     Fparams.ParseSQL(FSQL.Text,True, sqEscapeSlash in ConnOptions, sqEscapeRepeat in ConnOptions,psInterbase);
@@ -760,9 +772,11 @@ var db : tsqlconnection;
 begin
   if (Database <> Value) then
     begin
+    if assigned(value) and not (Value is TSQLConnection) then
+      DatabaseErrorFmt(SErrNotASQLConnection,[value.Name],self);
     UnPrepare;
-    if assigned(FCursor) then (Database as TSQLConnection).DeAllocateCursorHandle(FCursor);
-    db := value as tsqlconnection;
+    if assigned(FCursor) then TSQLConnection(DataBase).DeAllocateCursorHandle(FCursor);
+    db := TSQLConnection(Value);
     inherited setdatabase(value);
     if assigned(value) and (Transaction = nil) and (Assigned(db.Transaction)) then
       transaction := Db.Transaction;
@@ -794,7 +808,7 @@ var S : String;
 
 begin
   FreeFldBuffers;
-  (Database as tsqlconnection).UnPrepareStatement(FCursor);
+  TSQLConnection(Database).UnPrepareStatement(FCursor);
   FIsEOF := False;
   inherited internalclose;
 
@@ -802,7 +816,7 @@ begin
 
   if ServerFiltered then s := AddFilter(s);
 
-  (Database as tsqlconnection).PrepareStatement(Fcursor,(transaction as tsqltransaction),S,FParams);
+  TSQLConnection(Database).PrepareStatement(Fcursor,(transaction as tsqltransaction),S,FParams);
 
   Execute;
   inherited InternalOpen;
@@ -847,7 +861,7 @@ var
 begin
   if not IsPrepared then
     begin
-    db := (Database as tsqlconnection);
+    db := TSQLConnection(Database);
     sqltr := (transaction as tsqltransaction);
     if not assigned(Db) then
       DatabaseError(SErrDatabasenAssigned);
@@ -885,13 +899,13 @@ procedure TCustomSQLQuery.UnPrepare;
 
 begin
   CheckInactive;
-  if IsPrepared then with Database as TSQLConnection do
+  if IsPrepared then with TSQLConnection(DataBase) do
     UnPrepareStatement(FCursor);
 end;
 
 procedure TCustomSQLQuery.FreeFldBuffers;
 begin
-  if assigned(FCursor) then (Database as tsqlconnection).FreeFldBuffers(FCursor);
+  if assigned(FCursor) then TSQLConnection(Database).FreeFldBuffers(FCursor);
 end;
 
 function TCustomSQLQuery.Fetch : boolean;
@@ -899,7 +913,7 @@ begin
   if not (Fcursor.FStatementType in [stSelect]) then
     Exit;
 
-  if not FIsEof then FIsEOF := not (Database as tsqlconnection).Fetch(Fcursor);
+  if not FIsEof then FIsEOF := not TSQLConnection(Database).Fetch(Fcursor);
   Result := not FIsEOF;
 end;
 
@@ -907,13 +921,21 @@ procedure TCustomSQLQuery.Execute;
 begin
   If (FParams.Count>0) and Assigned(FMasterLink) then
     FMasterLink.CopyParamsFromMaster(False);
-  (Database as tsqlconnection).execute(Fcursor,Transaction as tsqltransaction, FParams);
+  TSQLConnection(Database).execute(Fcursor,Transaction as tsqltransaction, FParams);
 end;
 
 function TCustomSQLQuery.LoadField(FieldDef : TFieldDef;buffer : pointer; out CreateBlob : boolean) : boolean;
 
 begin
-  result := (Database as tSQLConnection).LoadField(FCursor,FieldDef,buffer, Createblob)
+  result := TSQLConnection(Database).LoadField(FCursor,FieldDef,buffer, Createblob)
+end;
+
+function TCustomSQLQuery.RowsAffected: TRowsCount;
+begin
+  Result := -1;
+  if not Assigned(Database) then Exit;
+  //assert(Database is TSQLConnection);
+  Result := TSQLConnection(Database).RowsAffected(FCursor);
 end;
 
 procedure TCustomSQLQuery.InternalAddRecord(Buffer: Pointer; AAppend: Boolean);
@@ -925,7 +947,7 @@ procedure TCustomSQLQuery.InternalClose;
 begin
   if StatementType = stSelect then FreeFldBuffers;
 // Database and FCursor could be nil, for example if the database is not assigned, and .open is called
-  if (not IsPrepared) and (assigned(database)) and (assigned(FCursor)) then (database as TSQLconnection).UnPrepareStatement(FCursor);
+  if (not IsPrepared) and (assigned(database)) and (assigned(FCursor)) then TSQLConnection(database).UnPrepareStatement(FCursor);
   if DefaultFields then
     DestroyFields;
   FIsEOF := False;
@@ -946,7 +968,7 @@ begin
   try
     FieldDefs.Clear;
 
-    (Database as tsqlconnection).AddFieldDefs(fcursor,FieldDefs);
+    TSQLConnection(Database).AddFieldDefs(fcursor,FieldDefs);
   finally
     FLoadingFieldDefs := False;
     FCursor.FInitFieldDef := false;
@@ -977,7 +999,7 @@ begin
   FWhereStartPos := 0;
   FWhereStopPos := 0;
   
-  ConnOptions := (DataBase as TSQLConnection).ConnOptions;
+  ConnOptions := TSQLConnection(DataBase).ConnOptions;
 
   repeat
     begin
@@ -1013,7 +1035,7 @@ begin
 
         case ParsePart of
           ppStart  : begin
-                     FCursor.FStatementType := (Database as tsqlconnection).StrToStatementType(s);
+                     FCursor.FStatementType := TSQLConnection(Database).StrToStatementType(s);
                      if FCursor.FStatementType = stSelect then ParsePart := ppSelect
                        else break;
                      if not FParseSQL then break;
@@ -1181,7 +1203,7 @@ begin
   finally
     // FCursor has to be assigned, or else the prepare went wrong before PrepareStatment was
     // called, so UnPrepareStatement shoudn't be called either
-    if (not IsPrepared) and (assigned(database)) and (assigned(FCursor)) then (database as TSQLConnection).UnPrepareStatement(Fcursor);
+    if (not IsPrepared) and (assigned(database)) and (assigned(FCursor)) then TSQLConnection(database).UnPrepareStatement(Fcursor);
   end;
 end;
 
@@ -1216,7 +1238,7 @@ destructor TCustomSQLQuery.Destroy;
 begin
   if Active then Close;
   UnPrepare;
-  if assigned(FCursor) then (Database as TSQLConnection).DeAllocateCursorHandle(FCursor);
+  if assigned(FCursor) then TSQLConnection(Database).DeAllocateCursorHandle(FCursor);
   FreeAndNil(FMasterLink);
   FreeAndNil(FParams);
   FreeAndNil(FSQL);
@@ -1268,7 +1290,7 @@ Procedure TCustomSQLQuery.UpdateIndexDefs;
 
 begin
   if assigned(DataBase) then
-    (DataBase as TSQLConnection).UpdateIndexDefs(FIndexDefs,FTableName);
+    TSQLConnection(DataBase).UpdateIndexDefs(FIndexDefs,FTableName);
 end;
 
 Procedure TCustomSQLQuery.ApplyRecUpdate(UpdateKind : TUpdateKind);
@@ -1416,13 +1438,13 @@ procedure TCustomSQLQuery.SetSchemaInfo( SchemaType : TSchemaType; SchemaObjectN
 begin
   ReadOnly := True;
   SQL.Clear;
-  SQL.Add((DataBase as tsqlconnection).GetSchemaInfoSQL(SchemaType, SchemaObjectName, SchemaPattern));
+  SQL.Add(TSQLConnection(DataBase).GetSchemaInfoSQL(SchemaType, SchemaObjectName, SchemaPattern));
 end;
 
 procedure TCustomSQLQuery.LoadBlobIntoBuffer(FieldDef: TFieldDef;
   ABlobBuf: PBufBlobField);
 begin
-  (DataBase as tsqlconnection).LoadBlobIntoBuffer(FieldDef, ABlobBuf, FCursor,(Transaction as tsqltransaction));
+  TSQLConnection(DataBase).LoadBlobIntoBuffer(FieldDef, ABlobBuf, FCursor,(Transaction as tsqltransaction));
 end;
 
 function TCustomSQLQuery.GetStatementType : TStatementType;
@@ -1636,6 +1658,68 @@ begin
   List.Text:=ConnDefs.Text;
 end;
 
+function StringsReplace(const S: string; OldPattern, NewPattern: array of string;  Flags: TReplaceFlags): string;
+
+var pc,pcc,lastpc : pchar;
+    strcount      : integer;
+    ResStr,
+    CompStr       : string;
+    Found         : Boolean;
+    sc            : integer;
+
+
+begin
+  sc := length(OldPattern);
+  if sc <> length(NewPattern) then
+    raise exception.Create(SErrAmountStrings);
+
+  dec(sc);
+
+  if rfIgnoreCase in Flags then
+    begin
+    CompStr:=AnsiUpperCase(S);
+    for strcount := 0 to sc do
+      OldPattern[strcount] := AnsiUpperCase(OldPattern[strcount]);
+    end
+  else
+    CompStr := s;
+
+  ResStr := '';
+  pc := @CompStr[1];
+  pcc := @s[1];
+  lastpc := pc+Length(S);
+
+  while pc < lastpc do
+    begin
+    Found := False;
+    for strcount := 0 to sc do
+      begin
+      if (length(OldPattern[strcount])>0) and
+         (OldPattern[strcount][1]=pc^) and
+         (Length(OldPattern[strcount]) <= (lastpc-pc)) and
+         (CompareByte(OldPattern[strcount][1],pc^,Length(OldPattern[strcount]))=0) then
+        begin
+        ResStr := ResStr + NewPattern[strcount];
+        pc := pc+Length(OldPattern[strcount]);
+        pcc := pcc+Length(OldPattern[strcount]);
+        Found := true;
+        end
+      end;
+    if not found then
+      begin
+      ResStr := ResStr + pcc^;
+      inc(pc);
+      inc(pcc);
+      end
+    else if not (rfReplaceAll in Flags) then
+      begin
+      ResStr := ResStr + StrPas(pcc);
+      break;
+      end;
+    end;
+  Result := ResStr;
+end;
+
 { TSQLConnector }
 
 procedure TSQLConnector.SetConnectorType(const AValue: String);
@@ -1792,6 +1876,12 @@ begin
   Result:=FProxy.LoadField(cursor, FieldDef, buffer, CreateBlob);
 end;
 
+function TSQLConnector.RowsAffected(cursor: TSQLCursor): TRowsCount;
+begin
+  CheckProxy;
+  Result := FProxy.RowsAffected(cursor);
+end;
+
 function TSQLConnector.GetTransactionHandle(trans: TSQLHandle): pointer;
 begin
   CheckProxy;

packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp

@@ -467,6 +467,7 @@ begin
   st:=TSQLite3Cursor(cursor).fstatement;
   fnum:= FieldDef.fieldno - 1;
   st1:= TStorageType(sqlite3_column_type(st,fnum));
+  CreateBlob:=false;
   result:= st1 <> stnull;
   if Not result then 
     Exit;
@@ -499,6 +500,7 @@ begin
               end;
     ftMemo,
     ftBlob: begin
+            CreateBlob:=True;
             int2:= sqlite3_column_bytes(st,fnum);
             {$WARNING Blob data not handled correctly }
             // int1:= addblobdata(sqlite3_column_text(st,fnum),int2);

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

@@ -304,7 +304,7 @@ end;
 
 function TSqlite3Dataset.GetSqliteVersion: String;
 begin
-  Result:=StrPas(sqlite3_version);
+  Result:=StrPas(sqlite3_version());
 end;
 
 function TSqlite3Dataset.QuickQuery(const ASql:String;const AStrList: TStrings;FillObjects:Boolean):String;

packages/fcl-db/tests/sqldbtoolsunit.pas

@@ -24,8 +24,8 @@ const MySQLdbTypes = [mysql40,mysql41,mysql50];
           '',
           '',
           'FLOAT',
-          'DECIMAL(18,4)',
           '',
+          'DECIMAL(18,4)',
           'DATE',
           'TIMESTAMP',
           'TIMESTAMP',
@@ -115,8 +115,13 @@ begin
     FieldtypeDefinitions[ftBlob] := 'TEXT';
     FieldtypeDefinitions[ftMemo] := 'TEXT';
     FieldtypeDefinitions[ftGraphic] := '';
+    FieldtypeDefinitions[ftCurrency] := 'MONEY';
+    end;
+  if SQLDbType = INTERBASE then
+    begin
+    Fconnection := tIBConnection.Create(nil);
+    FieldtypeDefinitions[ftLargeint] := 'BIGINT';
     end;
-  if SQLDbType = INTERBASE then Fconnection := tIBConnection.Create(nil);
   if SQLDbType = ODBC then Fconnection := tODBCConnection.Create(nil);
   if SQLDbType = ORACLE then Fconnection := TOracleConnection.Create(nil);
 

packages/fcl-db/tests/testdbbasics.pas

@@ -36,7 +36,9 @@ type
     procedure TestSupportFloatFields;
     procedure TestSupportLargeIntFields;
     procedure TestSupportDateFields;
-    
+    procedure TestSupportCurrencyFields;
+    procedure TestSupportBCDFields;
+
     procedure TestIsEmpty;
     procedure TestAppendOnEmptyDataset;
     procedure TestInsertOnEmptyDataset;
@@ -616,7 +618,8 @@ begin
 
   AFld := ADS.FindField('F'+FieldTypeNames[AfieldType]);
 
-  AssertNotNull('Fields of the type ' + FieldTypeNames[AfieldType] + ' are not supported by this type of dataset',AFld);
+  if not assigned (AFld) then
+    Ignore('Fields of the type ' + FieldTypeNames[AfieldType] + ' are not supported by this type of dataset');
   AssertTrue(Afld.DataType = AFieldType);
   AssertEquals(ADatasize,Afld.DataSize );
 end;
@@ -741,6 +744,42 @@ begin
   ds.close;
 end;
 
+procedure TTestDBBasics.TestSupportCurrencyFields;
+
+var i          : byte;
+    ds         : TDataset;
+    Fld        : TField;
+
+begin
+  TestfieldDefinition(ftCurrency,8,ds,Fld);
+
+  for i := 0 to testValuesCount-1 do
+    begin
+    AssertEquals(testCurrencyValues[i],Fld.AsCurrency);
+    AssertEquals(testCurrencyValues[i],Fld.AsFloat);
+    ds.Next;
+    end;
+  ds.close;
+end;
+
+procedure TTestDBBasics.TestSupportBCDFields;
+
+var i          : byte;
+    ds         : TDataset;
+    Fld        : TField;
+
+begin
+  TestfieldDefinition(ftBCD,8,ds,Fld);
+
+  for i := 0 to testValuesCount-1 do
+    begin
+    AssertEquals(testCurrencyValues[i],Fld.AsCurrency);
+    AssertEquals(testCurrencyValues[i],Fld.AsFloat);
+    ds.Next;
+    end;
+  ds.close;
+end;
+
 procedure TTestDBBasics.TestDoubleClose;
 begin
   with DBConnector.GetNDataset(1) do

packages/fcl-db/tests/testsqlfieldtypes.pas

@@ -26,6 +26,11 @@ type
     procedure TearDown; override;
     procedure RunTest; override;
   published
+    procedure TestInsertLargeStrFields; // bug 9600
+    procedure TestRowsAffected; // bug 9758
+    procedure TestStringsReplace;
+    procedure TestCircularParams;
+    procedure Test11Params;
     procedure TestBug9744;
     procedure TestCrossStringDateParam;
     procedure TestGetFieldNames;
@@ -343,7 +348,8 @@ var
   i             : byte;
 
 begin
-//  AssertTrue(SIgnoreAssertion,SQLDbType = postgresql); // Only postgres accept this type-definition
+  if SQLDbType<>postgresql then Ignore('This test does only apply to Postgres, since others don''t support varchars without length given');
+
   CreateTableWithFieldType(ftString,'VARCHAR');
   TestFieldDeclaration(ftString,dsMaxStringSize+1);
 
@@ -867,9 +873,137 @@ begin
     inherited RunTest;
 end;
 
+procedure TTestFieldTypes.TestInsertLargeStrFields;
+begin
+  with TSQLDBConnector(DBConnector) do
+    begin
+    Connection.ExecuteDirect('create table FPDEV2 (         ' +
+                              '  ID INT NOT NULL          , ' +
+                              '  NAME VARCHAR(16000),       ' +
+                              '  PRIMARY KEY (ID)           ' +
+                              ')                            ');
+// Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
+    TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
+    Query.SQL.Text := 'insert into FPDEV2(ID,NAME) values (1,''test1'')';
+    Query.ExecSQL;
+    query.sql.Text:='select * from FPDEV2';
+    Query.Open;
+    AssertEquals(query.FieldByName('NAME').AsString,'test1');
+    Query.insert;
+    query.fields[1].AsString:='11';
+    query.Close;
+    end;
+end;
+
+procedure TTestFieldTypes.TestRowsAffected;
+begin
+  with TSQLDBConnector(DBConnector) do
+    begin
+    AssertEquals(-1,query.RowsAffected);
+    Connection.ExecuteDirect('create table FPDEV2 (         ' +
+                              '  ID INT NOT NULL            , ' +
+                              '  NAME VARCHAR(250),         ' +
+                              '  PRIMARY KEY (ID)           ' +
+                              ')                            ');
+// Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
+    TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
+    Query.SQL.Text := 'insert into FPDEV2(ID,NAME) values (1,''test1'')';
+    Query.ExecSQL;
+    AssertEquals(1,query.RowsAffected);
+    Query.SQL.Text := 'insert into FPDEV2(ID,NAME) values (2,''test2'')';
+    Query.ExecSQL;
+    AssertEquals(1,query.RowsAffected);
+    Query.SQL.Text := 'update FPDEV2 set NAME=''NewTest''';
+    Query.ExecSQL;
+    AssertEquals(2,query.RowsAffected);
+    Query.SQL.Text := 'select * from FPDEV2';
+    Query.Open;
+    AssertTrue(query.RowsAffected<>0); // It should return -1 or the number of selected rows.
+    query.Close;
+    AssertEquals(-1,query.RowsAffected);
+    Query.SQL.Text := 'delete from FPDEV2';
+    Query.ExecSQL;
+    AssertEquals(2,query.RowsAffected);
+    Query.SQL.Text := 'delete from FPDEV2';
+    Query.ExecSQL;
+    AssertEquals(0,query.RowsAffected);
+    end;
+end;
+
+procedure TTestFieldTypes.TestStringsReplace;
+begin
+  AssertEquals('dit is een string',StringsReplace('dit was een string',['was'],['is'],[]));
+  AssertEquals('dit is een string was een string',StringsReplace('dit was een string was een string',['was'],['is'],[]));
+  AssertEquals('dit is een string is een string',StringsReplace('dit was een string was een string',['was'],['is'],[rfReplaceAll]));
+
+  AssertEquals('dit is een char is een char',StringsReplace('dit was een string was een string',['was','string'],['is','char'],[rfReplaceAll]));
+  AssertEquals('dit is een string was een string',StringsReplace('dit was een string was een string',['string','was'],['char','is'],[]));
+
+  AssertEquals('dit is een char is een strin',StringsReplace('dit was een string was een strin',['string','was'],['char','is'],[rfReplaceAll]));
+
+  AssertEquals('dit Was een char is een char',StringsReplace('dit Was een string was een string',['was','string'],['is','char'],[rfReplaceAll]));
+  AssertEquals('dit wAs een char is een char',StringsReplace('dit wAs een string was een string',['was','string'],['is','char'],[rfReplaceAll]));
+  AssertEquals('dit is een char is een char',StringsReplace('dit Was een sTring was een string',['was','string'],['is','char'],[rfReplaceAll,rfIgnoreCase]));
+  AssertEquals('dit is een char is een char',StringsReplace('dit wAs een STRING was een string',['was','string'],['is','char'],[rfReplaceAll,rfIgnoreCase]));
+
+  AssertEquals('dit was een si was een sa',StringsReplace('dit was een string was een straat',['straat','string'],['sa','si'],[rfReplaceAll]));
+  AssertEquals('dit was een si was een sa',StringsReplace('dit was een string was een straat',['string','straat'],['si','sa'],[rfReplaceAll]));
+
+  AssertEquals('dit was een sing was een saat',StringsReplace('dit was een string was een straat',['str','string'],['s','si'],[rfReplaceAll]));
+  AssertEquals('dit was een si was een saat',StringsReplace('dit was een string was een straat',['string','str'],['si','s'],[rfReplaceAll]));
+
+  AssertEquals('dit was een string was een string',StringsReplace('dit was een string was een string',[''],['is'],[rfReplaceAll]));
+  AssertEquals('dit  een string  een string',StringsReplace('dit was een string was een string',['was'],[''],[rfReplaceAll]));
+end;
+
+procedure TTestFieldTypes.TestCircularParams;
+begin
+  with TSQLDBConnector(dbconnector) do
+    begin
+    Connection.ExecuteDirect('create table FPDEV2 (id1 int, id2 int,vchar varchar(10))');
+    // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
+    TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
+
+    Query.sql.Text := 'insert into FPDEV2 values(:id1,:id2,:vchar)';
+    query.params[0].asinteger := 1;
+    query.params[1].asinteger := 1;
+    query.params[2].asstring := '$1 :id2 $';
+    query.ExecSQL;
+    query.sql.text := 'select * from FPDEV2';
+    query.open;
+    AssertEquals(1,query.fields[0].asinteger);
+    AssertEquals(1,query.fields[1].asinteger);
+    AssertEquals('$1 :id2 $',query.fields[2].AsString);
+    query.close;
+    end;
+end;
+
+procedure TTestFieldTypes.Test11Params;
+var i : integer;
+begin
+  with TSQLDBConnector(dbconnector) do
+    begin
+    Connection.ExecuteDirect('create table FPDEV2 (id1 int, id2 int, id3 int, id4 int,id5 int,id6 int,id7 int,id8 int, id9 int, id10 int, id11 int)');
+    // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
+    TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
+
+    Query.sql.Text := 'insert into FPDEV2 values(:id1,:id2,:id3,:id4,:id5,:id6,:id7,:id8,:id9,:id10,:id11)';
+    for i := 0 to 10 do
+      query.params[i].asinteger := 1;
+    query.ExecSQL;
+    query.sql.text := 'select * from FPDEV2';
+    query.open;
+    for i := 0 to 10 do
+      AssertEquals(1,query.fields[i].asinteger);
+    query.close;
+    end;
+end;
+
 procedure TTestFieldTypes.TestBug9744;
 var i : integer;
 begin
+  if SQLDbType in [interbase,postgresql] then Ignore('This test does not apply to this db-engine, since it has no double field-type');
+
   with TSQLDBConnector(DBConnector) do
     begin
     try
@@ -931,11 +1065,11 @@ begin
   ds.Prepare;
   ds.IndexDefs.Update;
   AssertEquals(1,ds.IndexDefs.count);
-  AssertEquals('ID',ds.indexdefs[0].Fields);
+  AssertTrue(CompareText('ID',ds.indexdefs[0].Fields)=0);
   Asserttrue(ds.indexdefs[0].Options=[ixPrimary,ixUnique]);
   ds.IndexDefs.Update;
   AssertEquals(1,ds.IndexDefs.count);
-  AssertEquals('ID',ds.indexdefs[0].Fields);
+  AssertTrue(CompareText('ID',ds.indexdefs[0].Fields)=0);
   Asserttrue(ds.indexdefs[0].Options=[ixPrimary,ixUnique]);
 end;
 
@@ -968,6 +1102,8 @@ end;
 
 procedure TTestFieldTypes.TestTemporaryTable;
 begin
+  if SQLDbType=interbase then Ignore('This test does not apply to Interbase/Firebird, since it doesn''t support temporary tables');
+
   with TSQLDBConnector(DBConnector).Query do
     begin
     SQL.Clear;
@@ -993,13 +1129,13 @@ begin
   AssertEquals(1,ds.IndexDefs.count);
   inddefs := HackedDataset(ds).GetIndexDefs(ds.IndexDefs,[ixPrimary]);
   AssertEquals(1,inddefs.count);
-  AssertEquals('ID',inddefs[0].Fields);
+  AssertTrue(CompareText('ID',inddefs[0].Fields)=0);
   Asserttrue(inddefs[0].Options=[ixPrimary,ixUnique]);
   inddefs.Free;
 
   inddefs := HackedDataset(ds).GetIndexDefs(ds.IndexDefs,[ixPrimary,ixUnique]);
   AssertEquals(1,inddefs.count);
-  AssertEquals('ID',inddefs[0].Fields);
+  AssertTrue(CompareText('ID',inddefs[0].Fields)=0);
   Asserttrue(inddefs[0].Options=[ixPrimary,ixUnique]);
   inddefs.Free;
 
@@ -1021,14 +1157,18 @@ end;
 
 procedure TTestFieldTypes.TestParametersAndDates;
 // See bug 7205
+var ADateStr : String;
 begin
+  if SQLDbType=interbase then Ignore('This test does not apply to Interbase/Firebird, since it doesn''t use semicolons for casts');
+
   with TSQLDBConnector(DBConnector).Query do
     begin
     SQL.Clear;
     sql.add('select now()::date as current_date where 1=1');
     open;
     first;
-    writeln(fields[0].asstring); // return the correct date
+    ADateStr:=fields[0].asstring; // return the correct date
+    // writeln(fields[0].asstring);
     close;
 
     sql.clear;
@@ -1036,13 +1176,17 @@ begin
     params.parambyname('PARAM1').asinteger:= 1;
     open;
     first;
-    writeln(fields[0].asstring); // return invalid date
+    AssertEquals(ADateStr,fields[0].asstring); // return invalid date
+    // writeln(fields[0].asstring);
     close;
 
     end
 end;
 
 procedure TTestFieldTypes.TestExceptOnsecClose;
+
+var passed : boolean;
+
 begin
   with TSQLDBConnector(DBConnector).Query do
     begin
@@ -1054,13 +1198,14 @@ begin
     
     SQL.Clear;
     SQL.Add('select blaise from FPDEV');
-{$IFDEF FPC}
-//    AssertException(EIBDatabaseError,@Open);
-{$ELSE}
-//    AssertException(EIBDatabaseError,Open);
-{$ENDIF}
-
-    Open;
+    passed := false;
+    try
+      open;
+    except
+      on E: Exception do
+        passed := (E.ClassType.InheritsFrom(EDatabaseError))
+      end;
+    AssertTrue(passed);
 
     Close;
     end;

packages/fcl-db/tests/toolsunit.pas

@@ -80,6 +80,7 @@ const
 const
   testValuesCount = 25;
   testFloatValues : Array[0..testValuesCount-1] of double = (-maxSmallint-1,-maxSmallint,-256,-255,-128,-127,-1,0,1,127,128,255,256,maxSmallint,maxSmallint+1,0.123456,-0.123456,4.35,12.434E7,9.876e-5,123.45678,2.4,3.2,0.4,23);
+  testCurrencyValues : Array[0..testValuesCount-1] of currency = (-100,-65.5,-54.34,-43.34,-2.50,-0.2,45.40,0.3,45.4,127,128,255,256,45,0.3,45.4,127,128,255,256,45,1234.56,43.23,43.43,99.88);
   testIntValues : Array[0..testValuesCount-1] of integer = (-maxInt,-maxInt+1,-maxSmallint-1,-maxSmallint,-256,-255,-128,-127,-1,0,1,127,128,255,256,maxSmallint,maxSmallint+1,MaxInt-1,MaxInt,100,130,150,-150,-132,234);
   testSmallIntValues : Array[0..testValuesCount-1] of smallint = (-maxSmallint,-maxSmallint+1,-256,-255,-128,-127,-1,0,1,127,128,255,256,maxSmallint,maxSmallint-1,100,110,120,130,150,-150,-132,234,231,42);
   testLargeIntValues : Array[0..testValuesCount-1] of smallint = (-MaxSIntValue,MaxSIntValue+1,-maxInt-1,-maxInt+1,-maxSmallint,-maxSmallint+1,-256,-255,-128,-127,-1,0,1,127,128,255,256,maxSmallint,maxSmallint-1,maxSmallint+1,MaxInt-1,MaxInt,MaxSIntValue-1,MaxSIntValue,235253244);
@@ -228,6 +229,11 @@ begin
     testValues[ftFloat,i] := FloatToStr(testFloatValues[i]);
     testValues[ftSmallint,i] := IntToStr(testSmallIntValues[i]);
     testValues[ftInteger,i] := IntToStr(testIntValues[i]);
+    testValues[ftLargeint,i] := IntToStr(testLargeIntValues[i]);
+    DecimalSeparator:=',';
+    testValues[ftCurrency,i] := CurrToStr(testCurrencyValues[i]);
+    DecimalSeparator:='.';
+    testValues[ftBCD,i] := CurrToStr(testCurrencyValues[i]);
     end;
 
   if dbconnectorname = '' then raise Exception.Create('There is no db-connector specified');

packages/fcl-registry/src/registry.pp

@@ -14,8 +14,8 @@ Uses
     Windows,
   {$endif XMLREG}
     Classes,
-    inifiles,
-    SysUtils;
+    SysUtils,
+    inifiles;
 
   {$I regdef.inc}
 
@@ -101,6 +101,7 @@ type
     function ValueExists(const Name: string): Boolean;
 
     procedure CloseKey;
+    procedure CloseKey(key:HKEY);
     procedure GetKeyNames(Strings: TStrings);
     procedure GetValueNames(Strings: TStrings);
     procedure MoveKey(const OldName, NewName: string; Delete: Boolean);
@@ -151,6 +152,40 @@ type
     property FileName: String read fFileName;
   end;
 
+{ ---------------------------------------------------------------------
+    TRegIniFile
+  ---------------------------------------------------------------------}
+
+
+  TRegistryIniFile = class(TCustomIniFile)
+  private
+    FRegIniFile: TRegIniFile;
+  public
+    constructor Create(const AFileName: string); overload;
+    constructor Create(const AFileName: string; AAccess: LongWord); overload;
+    function ReadDate(const Section, Name: string; Default: TDateTime): TDateTime; override;
+    function ReadDateTime(const Section, Name: string; Default: TDateTime): TDateTime; override;
+    function ReadInteger(const Section, Name: string; Default: Longint): Longint; override;
+    function ReadFloat(const Section, Name: string; Default: Double): Double; override;
+    function ReadString(const Section, Name, Default: string): string; override;
+    function ReadTime(const Section, Name: string; Default: TDateTime): TDateTime; override;
+    function ReadBinaryStream(const Section, Name: string; Value: TStream): Integer; override;
+    procedure WriteDate(const Section, Name: string; Value: TDateTime); override;
+    procedure WriteDateTime(const Section, Name: string; Value: TDateTime); override;
+    procedure WriteFloat(const Section, Name: string; Value: Double); override;
+    procedure WriteInteger(const Section, Name: string; Value: Longint); override;
+    procedure WriteString(const Section, Name, Value: String); override;
+    procedure WriteTime(const Section, Name: string; Value: TDateTime); override;
+    procedure WriteBinaryStream(const Section, Name: string; Value: TStream); override;
+    procedure ReadSection(const Section: string; Strings: TStrings); override;
+    procedure ReadSections(Strings: TStrings); override;
+    procedure ReadSectionValues(const Section: string; Strings: TStrings); override;
+    procedure EraseSection(const Section: string); override;
+    procedure DeleteKey(const Section, Name: String); override;
+    procedure UpdateFile; override;
+    property RegIniFile: TRegIniFile read FRegIniFile;
+  end;
+
 ResourceString
   SInvalidRegType   = 'Invalid registry data type: "%s"';
   SRegCreateFailed  = 'Failed to create key: "%s"';
@@ -411,12 +446,389 @@ begin
 
 end;
 
-
 { ---------------------------------------------------------------------
     Include TRegIniFile implementation
   ---------------------------------------------------------------------}
 
-
 {$i regini.inc}
 
+{ TRegistryIniFile }
+
+// interface from
+// http://www.koders.com/delphi/fid65C1FFAEF89B0CDC4B93FF94C1819686CA6141FC.aspx
+constructor TRegistryIniFile.Create(const AFileName: string;
+  AAccess: LongWord);
+begin
+  inherited create(AFilename);
+  FRegInifile:=TreginiFile.Create(AFileName,AAccess);
+end;
+
+constructor TRegistryIniFile.Create(const AFileName: string);
+begin
+  Create(AFileName,KEY_ALL_ACCESS);
+end;
+
+procedure TRegistryIniFile.DeleteKey(const Section, Name: String);
+begin
+  FRegIniFile.Deletekey(section,name);
+end;
+
+procedure TRegistryIniFile.EraseSection(const Section: string);
+begin
+  FRegIniFile.EraseSection(section);
+end;
+
+function TRegistryIniFile.ReadBinaryStream(const Section, Name: string;
+  Value: TStream): Integer;
+begin
+  result:=-1; // unimplemented
+ // 
+end;
+
+function TRegistryIniFile.ReadDate(const Section, Name: string;
+  Default: TDateTime): TDateTime;
+var sectkey,curkey : HKey;
+begin 
+  with FRegInifile do
+    begin
+      sectkey:=getkey(Section);
+      if sectkey<>0 then
+        begin           
+          try // allocation ok
+            curkey:=FRegIniFile.CurrentKey;               
+            SetCurrentKey(sectKey);
+            try             // save current key
+              if ValueExists(Name) THen 
+                result:=FRegIniFile.ReadDate(Name)
+              else
+                result:=default;
+            finally
+              SetCurrentKey(CurKey);
+              end;
+          finally
+            closekey(sectkey);
+            end;
+        end
+       else
+         result:=default; 
+    end;          
+end;
+
+function TRegistryIniFile.ReadDateTime(const Section, Name: string;
+  Default: TDateTime): TDateTime;
+var sectkey,curkey : HKey;  
+begin
+  with FRegInifile do
+    begin
+      sectkey:=getkey(Section);
+      if sectkey<>0 then
+        begin           
+          try // allocation ok
+            curkey:=FRegIniFile.CurrentKey;               
+            SetCurrentKey(sectKey);
+            try             // save current key
+              if ValueExists(Name) THen 
+                result:=FRegIniFile.ReadDateTime(Name)
+              else
+                result:=default;
+            finally
+              SetCurrentKey(CurKey);
+              end;
+          finally
+            closekey(sectkey);
+            end;
+        end
+       else
+         result:=default; 
+    end;          
+end;
+
+function TRegistryIniFile.ReadFloat(const Section, Name: string;
+  Default: Double): Double;
+var sectkey,curkey : HKey;  
+begin
+  with FRegInifile do
+    begin
+      sectkey:=getkey(Section);
+      if sectkey<>0 then
+        begin           
+          try // allocation ok
+            curkey:=FRegIniFile.CurrentKey;               
+            SetCurrentKey(sectKey);
+            try             // save current key
+              if ValueExists(Name) THen 
+                result:=FRegIniFile.ReadFloat(Name)
+              else
+                result:=default;
+            finally
+              SetCurrentKey(CurKey);
+              end;
+          finally
+            closekey(sectkey);
+            end;
+        end
+       else
+         result:=default; 
+    end;          
+end;
+
+function TRegistryIniFile.ReadInteger(const Section, Name: string;
+  Default: Integer): Longint;
+var sectkey,curkey : HKey;  
+begin
+  with FRegInifile do
+    begin
+      sectkey:=getkey(Section);
+      if sectkey<>0 then
+        begin           
+          try // allocation ok
+            curkey:=FRegIniFile.CurrentKey;               
+            SetCurrentKey(sectKey);
+            try             // save current key
+              if ValueExists(Name) THen 
+                result:=FRegIniFile.ReadInteger(section,Name,default)
+              else
+                result:=default;
+            finally
+              SetCurrentKey(CurKey);
+              end;
+          finally
+            closekey(sectkey);
+            end;
+        end
+       else
+         result:=default; 
+    end;          
+end;
+
+procedure TRegistryIniFile.ReadSection(const Section: string;
+  Strings: TStrings);
+begin
+  FRegIniFile.ReadSection(Section,strings);
+end;
+
+procedure TRegistryIniFile.ReadSections(Strings: TStrings);
+begin
+  FRegIniFile.ReadSections(strings);
+end;
+
+procedure TRegistryIniFile.ReadSectionValues(const Section: string;
+  Strings: TStrings);
+begin
+  FRegIniFile.ReadSectionValues(Section,strings);
+end;
+
+function TRegistryIniFile.ReadString(const Section, Name,
+  Default: string): string;
+var sectkey,curkey : HKey;  
+begin
+  with FRegInifile do
+    begin
+      sectkey:=getkey(Section);
+      if sectkey<>0 then
+        begin           
+          try // allocation ok
+            curkey:=FRegIniFile.CurrentKey;               
+            SetCurrentKey(sectKey);
+            try             // save current key
+              if ValueExists(Name) THen 
+                result:=FRegIniFile.ReadString(section,Name,default)
+              else
+                result:=default;
+            finally
+              SetCurrentKey(CurKey);
+              end;
+          finally
+            closekey(sectkey);
+            end;
+        end
+       else
+         result:=default; 
+    end;          
+end;
+
+function TRegistryIniFile.ReadTime(const Section, Name: string;
+  Default: TDateTime): TDateTime;
+var sectkey,curkey : HKey;  
+begin
+  with FRegInifile do
+    begin
+      sectkey:=getkey(Section);
+      if sectkey<>0 then
+        begin           
+          try // allocation ok
+            curkey:=FRegIniFile.CurrentKey;               
+            SetCurrentKey(sectKey);
+            try             // save current key
+              if ValueExists(Name) THen 
+                result:=FRegIniFile.ReadTime(Name)
+              else
+                result:=default;
+            finally
+              SetCurrentKey(CurKey);
+              end;
+          finally
+            closekey(sectkey);
+            end;
+        end
+       else
+         result:=default; 
+    end;          
+end;
+
+procedure TRegistryIniFile.UpdateFile;
+begin
+//  FRegIniFile.UpdateFile; ??
+end;
+
+procedure TRegistryIniFile.WriteBinaryStream(const Section, Name: string;
+  Value: TStream);
+begin
+ // ??
+end;
+
+procedure TRegistryIniFile.WriteDate(const Section, Name: string;
+  Value: TDateTime);
+var sectkey,curkey : HKey;  
+begin
+  with FRegInifile do
+    begin
+      sectkey:=getkey(Section);
+      if sectkey<>0 then
+        begin           
+          try // allocation ok
+            curkey:=FRegIniFile.CurrentKey;               
+            SetCurrentKey(sectKey);
+            try             // save current key
+              FRegIniFile.WriteDate(name,value)
+            finally
+              SetCurrentKey(CurKey);
+              end;
+          finally
+            closekey(sectkey);
+            end;
+        end
+    end;          
+end;
+
+procedure TRegistryIniFile.WriteDateTime(const Section, Name: string;
+  Value: TDateTime);
+var sectkey,curkey : HKey;  
+begin
+  with FRegInifile do
+    begin
+      sectkey:=getkey(Section);
+      if sectkey<>0 then
+        begin           
+          try // allocation ok
+            curkey:=FRegIniFile.CurrentKey;               
+            SetCurrentKey(sectKey);
+            try             // save current key
+              FRegIniFile.WriteDateTime(Name,value)
+            finally
+              SetCurrentKey(CurKey);
+              end;
+          finally
+            closekey(sectkey);
+            end;
+        end
+    end;
+end;
+
+procedure TRegistryIniFile.WriteFloat(const Section, Name: string;
+  Value: Double);
+var sectkey,curkey : HKey;  
+begin
+  with FRegInifile do
+    begin
+      sectkey:=getkey(Section);
+      if sectkey<>0 then
+        begin           
+          try // allocation ok
+            curkey:=FRegIniFile.CurrentKey;               
+            SetCurrentKey(sectKey);
+            try             // save current key
+              FRegIniFile.WriteFloat(Name,value)
+            finally
+              SetCurrentKey(CurKey);
+              end;
+          finally
+            closekey(sectkey);
+            end;
+        end
+    end;          
+end;
+
+procedure TRegistryIniFile.WriteInteger(const Section, Name: string;
+  Value: Integer);
+var sectkey,curkey : HKey;  
+begin
+  with FRegInifile do
+    begin
+      sectkey:=getkey(Section);
+      if sectkey<>0 then
+        begin           
+          try // allocation ok
+            curkey:=FRegIniFile.CurrentKey;               
+            SetCurrentKey(sectKey);
+            try             // save current key
+              FRegIniFile.WriteInteger(section,Name,value)
+            finally
+              SetCurrentKey(CurKey);
+              end;
+          finally
+            closekey(sectkey);
+            end;
+        end
+    end;          
+
+end;
+
+procedure TRegistryIniFile.WriteString(const Section, Name, Value: String);
+var sectkey,curkey : HKey;  
+begin
+  with FRegInifile do
+    begin
+      sectkey:=getkey(Section);
+      if sectkey<>0 then
+        begin           
+          try // allocation ok
+            curkey:=FRegIniFile.CurrentKey;               
+            SetCurrentKey(sectKey);
+            try             // save current key
+              FRegIniFile.WriteString(section,Name,value)
+            finally
+              SetCurrentKey(CurKey);
+              end;
+          finally
+            closekey(sectkey);
+            end;
+        end
+    end;
+end;
+
+procedure TRegistryIniFile.WriteTime(const Section, Name: string;
+  Value: TDateTime);
+var sectkey,curkey : HKey;
+begin
+  with FRegInifile do
+    begin
+      sectkey:=getkey(Section);
+      if sectkey<>0 then
+        begin
+          try // allocation ok
+            curkey:=FRegIniFile.CurrentKey;
+            SetCurrentKey(sectKey);
+            try             // save current key
+              FRegIniFile.WriteTime(Name,value)
+            finally
+              SetCurrentKey(CurKey);
+              end;
+          finally
+            closekey(sectkey);
+            end;
+        end
+    end;
+end;
+
 end.

packages/fcl-registry/src/winreg.inc

@@ -258,6 +258,11 @@ begin
     end
 end;
 
+procedure TRegistry.CloseKey(key:HKEY);
+begin
+  RegCloseKey(CurrentKey)
+end;
+
 procedure TRegistry.ChangeKey(Value: HKey; const Path: String);
 begin
   CloseKey;

packages/fcl-registry/src/xmlreg.pp

@@ -352,19 +352,23 @@ begin
     begin
     Node[SType]:=IntToStr(Ord(DataType));
     DataNode:=Node.FirstChild;
-    Case DataType of
-      dtDWORD : DataNode.NodeValue:=IntToStr(PCardinal(@Data)^);
-      dtString : begin
-                 SetLength(S,DataSize);
-                 If (DataSize>0) then
-                   Move(Data,S[1],DataSize);
-                 DataNode.NodeValue:=S;
-                 end;
-      dtBinary : begin
-                 S:=BufToHex(Data,DataSize);
-                 DataNode.NodeValue:=S;
-                 end;
-    end;
+    Result:=DataNode<>Nil;  // Bug 9879. Create child here?
+    If Result Then
+      begin 
+        Case DataType of
+          dtDWORD : DataNode.NodeValue:=IntToStr(PCardinal(@Data)^);
+          dtString : begin
+                     SetLength(S,DataSize);
+                     If (DataSize>0) then
+                       Move(Data,S[1],DataSize);
+                     DataNode.NodeValue:=S;
+                     end;
+          dtBinary : begin
+                     S:=BufToHex(Data,DataSize);
+                     DataNode.NodeValue:=S;
+                     end;
+        end;
+      end;
     end;
   If Result then
     begin
@@ -711,11 +715,12 @@ Var
 
 begin
   N:=FindValueKey(OldName);
-  If (N<>Nil) then
+  result:=n<>nil;
+  If (Result) then
     begin
-    N[SName]:=NewName;
-    FDirty:=True;
-    MaybeFlush;
+      N[SName]:=NewName;
+      FDirty:=True;
+      MaybeFlush;
     end;
 end;
 

packages/fcl-registry/src/xregreg.inc

@@ -239,3 +239,10 @@ begin
   TXMLRegistry(FSysData).Flush;
   TXMLRegistry(FSysData).SetRootKey(TXMLRegistry(FSysData).RootKey);
 end;
+
+procedure TRegistry.CloseKey(key:HKEY);
+
+begin
+  TXMLRegistry(FSysData).Flush;
+  TXMLRegistry(FSysData).SetRootKey(TXMLRegistry(FSysData).RootKey);
+end;

packages/fcl-xml/src/dom.pp

@@ -231,7 +231,8 @@ type
 
     function InsertBefore(NewChild, RefChild: TDOMNode): TDOMNode; virtual;
     function ReplaceChild(NewChild, OldChild: TDOMNode): TDOMNode; virtual;
-    function RemoveChild(OldChild: TDOMNode): TDOMNode; virtual;
+    function DetachChild(OldChild: TDOMNode): TDOMNode; virtual;
+    function RemoveChild(OldChild: TDOMNode): TDOMNode;
     function AppendChild(NewChild: TDOMNode): TDOMNode; virtual;
     function HasChildNodes: Boolean; virtual;
     function CloneNode(deep: Boolean): TDOMNode; overload;
@@ -276,12 +277,11 @@ type
     procedure FreeChildren;
     function GetTextContent: DOMString; override;
     procedure SetTextContent(const AValue: DOMString); override;
-    function DoRemoveChild(OldChild: TDOMNode): TDOMNode;
   public
     destructor Destroy; override;
     function InsertBefore(NewChild, RefChild: TDOMNode): TDOMNode; override;
     function ReplaceChild(NewChild, OldChild: TDOMNode): TDOMNode; override;
-    function RemoveChild(OldChild: TDOMNode): TDOMNode; override;
+    function DetachChild(OldChild: TDOMNode): TDOMNode; override;
     function AppendChild(NewChild: TDOMNode): TDOMNode; override;
     function HasChildNodes: Boolean; override;
     function FindNode(const ANodeName: DOMString): TDOMNode; override;
@@ -419,6 +419,7 @@ type
     function IndexOfNS(const nsURI: DOMString): Integer;
     function FindID(const aID: DOMString; out Index: LongWord): Boolean;
     procedure ClearIDList;
+    procedure RemoveID(Elem: TDOMElement);
   public
     property DocType: TDOMDocumentType read GetDocType;
     property Impl: TDOMImplementation read FImplementation;
@@ -453,7 +454,6 @@ type
     constructor Create;
     destructor Destroy; override;
     function AddID(Attr: TDOMAttr): Boolean;
-    procedure RemoveID(Attr: TDOMAttr);
   end;
 
   TXMLDocument = class(TDOMDocument)
@@ -815,8 +815,8 @@ end;
 
 destructor TDOMNode.Destroy;
 begin
-  if Assigned(FParentNode) and FParentNode.InheritsFrom(TDOMNode_WithChildren) then
-    TDOMNode_WithChildren(FParentNode).DoRemoveChild(Self);
+  if Assigned(FParentNode) then
+    FParentNode.DetachChild(Self);
   inherited Destroy;
 end;
 
@@ -867,13 +867,20 @@ begin
   Result:=nil;
 end;
 
-function TDOMNode.RemoveChild(OldChild: TDOMNode): TDOMNode;
+function TDOMNode.DetachChild(OldChild: TDOMNode): TDOMNode;
 begin
   // OldChild isn't in our child list
   raise EDOMNotFound.Create('Node.RemoveChild');
   Result:=nil;
 end;
 
+function TDOMNode.RemoveChild(OldChild: TDOMNode): TDOMNode;
+begin
+  DetachChild(OldChild);
+  OldChild.Free;
+  Result:=nil;
+end;
+
 function TDOMNode.AppendChild(NewChild: TDOMNode): TDOMNode;
 begin
   raise EDOMHierarchyRequest.Create('Node.AppendChild');
@@ -1040,10 +1047,8 @@ begin
 
   Inc(FOwnerDocument.FRevision); // invalidate nodelists
 
-  // ugly workaround for RemoveChild issue... 
   if Assigned(NewChild.FParentNode) then
-    if NewChild.FParentNode.InheritsFrom(TDOMNode_WithChildren) then
-      TDOMNode_WithChildren(NewChild.FParentNode).DoRemoveChild(NewChild);
+    NewChild.FParentNode.DetachChild(NewChild);
 
   // DONE: Implemented InsertBefore for DocumentFragments (except ChildNodeTree)
   if NewChild.NodeType = DOCUMENT_FRAGMENT_NODE then
@@ -1109,7 +1114,7 @@ begin
   Result := NewChild;
 end;
 
-function TDOMNode_WithChildren.DoRemoveChild(OldChild: TDOMNode): TDOMNode;
+function TDOMNode_WithChildren.DetachChild(OldChild: TDOMNode): TDOMNode;
 begin
   if OldChild.ParentNode <> Self then
     raise EDOMNotFound.Create('NodeWC.RemoveChild');
@@ -1134,15 +1139,6 @@ begin
   Result := OldChild;
 end;
 
-function TDOMNode_WithChildren.RemoveChild(OldChild: TDOMNode):
-  TDOMNode;
-begin
-  DoRemoveChild(OldChild);
-  // DOM level 2: Must return removed node
-  OldChild.Free;
-  Result:=nil;
-end;
-
 function TDOMNode_WithChildren.AppendChild(NewChild: TDOMNode): TDOMNode;
 var
   Tmp: TDOMNode;
@@ -1160,11 +1156,8 @@ begin
 
   Inc(FOwnerDocument.FRevision); // invalidate nodelists
 
-  // TODO: RemoveChild destroys removed node -> CRASH
-  // this is a very ugly workaround...
   if Assigned(NewChild.FParentNode) then
-    if NewChild.FParentNode.InheritsFrom(TDOMNode_WithChildren) then
-      TDOMNode_WithChildren(NewChild.FParentNode).DoRemoveChild(NewChild);
+    NewChild.FParentNode.DetachChild(NewChild);
 
   // DONE: supported AppendChild for DocumentFragments (except ChildNodeTree)
   if NewChild.NodeType = DOCUMENT_FRAGMENT_NODE then
@@ -1671,13 +1664,12 @@ begin
   inherited Create(nil);
   // TODO: DOM lvl 2 states that Document should be unowned. Any dependencies?
   FOwnerDocument := Self;
-  FIDList := TList.Create;
 end;
 
 destructor TDOMDocument.Destroy;
 begin
   ClearIDList;
-  FIDList.Free;
+  FreeAndNil(FIDList);   // set to nil before starting destroying chidlren
   inherited Destroy;
 end;
 
@@ -1686,6 +1678,8 @@ var
   I: Cardinal;
   Item: PIDItem;
 begin
+  if FIDList = nil then
+    FIDList := TList.Create;
   New(Item);
   Item^.ID := Attr.Value;
   Item^.Element := Attr.OwnerElement;
@@ -1701,9 +1695,21 @@ begin
   end;
 end;
 
-procedure TDOMDocument.RemoveID(Attr: TDOMAttr);
+// This shouldn't be called if document has no IDs,
+// or when it is being destroyed
+procedure TDOMDocument.RemoveID(Elem: TDOMElement);
+var
+  I: Integer;
 begin
-  // TODO: Implement this
+  for I := 0 to FIDList.Count-1 do
+  begin
+    if PIDItem(FIDList.List^[I])^.Element = Elem then
+    begin
+      Dispose(PIDItem(FIDList.List^[I]));
+      FIDList.Delete(I);
+      Exit;
+    end;
+  end;
 end;
 
 function TDOMDocument.FindID(const aID: DOMString; out Index: LongWord): Boolean;
@@ -1886,8 +1892,7 @@ function TDOMDocument.GetElementById(const ElementID: DOMString): TDOMElement;
 var
   I: Cardinal;
 begin
-  // TODO: Implement TDOMDocument.GetElementById
-  if FindID(ElementID, I) then
+  if Assigned(FIDList) and FindID(ElementID, I) then
     Result := PIDItem(FIDList.List^[I])^.Element
   else
     Result := nil;
@@ -1998,6 +2003,8 @@ end;
 
 destructor TDOMElement.Destroy;
 begin
+  if Assigned(FOwnerDocument.FIDList) then
+    FOwnerDocument.RemoveID(Self);
   // FIX: Attribute nodes are now freed by TDOMNamedNodeMap.Destroy
   FreeAndNil(FAttributes);
   inherited Destroy;

packages/fcl-xml/src/xmlread.pp

@@ -260,41 +260,32 @@ type
   private
     FParent: TContentParticle;
     FChildren: TList;
-    function InternalMatch(List: TList; var Index: Integer): Boolean;
+    FIndex: Integer;
     function GetChildCount: Integer;
     function GetChild(Index: Integer): TContentParticle;
   public
     CPType: TCPType;
     CPQuant: TCPQuant;
     Name: WideString;
-    constructor Create;
     destructor Destroy; override;
     function Add: TContentParticle;
-    function MatchNodeList(List: TList; var Index: Integer): Boolean;
+    function IsRequired: Boolean;
+    function FindFirst(const aName: DOMString): TContentParticle;
+    function FindNext(const aName: DOMString; ChildIdx: Integer): TContentParticle;
+    function MoreRequired(ChildIdx: Integer): Boolean;
     property ChildCount: Integer read GetChildCount;
     property Children[Index: Integer]: TContentParticle read GetChild;
   end;
 
-  // This class is intended to store context information during parsing
-  // However, right now it's written to validate completely parsed elements
   TElementValidator = class(TObject)
   private
     FParent: TElementValidator;
-    // to be deleted
-    FList: TList;
     FElementDef: TDOMElementDef;
-    FIndex: Integer;
-    FChildElementCount: Integer;
     FCurCP: TContentParticle;
-    FAmbiguous: Boolean;
+    FFailed: Boolean;
   public
-    constructor Create(aElDef: TDOMElementDef);
-    destructor Destroy; override;
-    // to be deleted
-    procedure AddElement(aNode: TDOMElement);
-    // to be deleted
-    function Match: Boolean;
     function IsElementAllowed(const aName: DOMString): Boolean;
+    function Incomplete: Boolean;
     property Parent: TElementValidator read FParent write FParent;
   end;
 
@@ -352,9 +343,9 @@ type
     procedure CallErrorHandler(E: EXMLReadError);
   protected
     FCursor: TDOMNode;
-    // TODO: probably TObjectList
-    FValStack: TList;    // validation: keep track of models
+    FValidator: TElementValidator;
 
+    procedure DoError(Severity: TErrorSeverity; const descr: string; AtTokenStart: Boolean=False);
     procedure FatalError(const descr: String; AtTokenStart: Boolean=False); overload;
     procedure FatalError(const descr: string; const args: array of const; AtTokenStart: Boolean=False); overload;
     procedure FatalError(Expected: WideChar); overload;
@@ -371,7 +362,6 @@ type
     function  CheckName: Boolean;
     function  CheckNmToken: Boolean;
     function  ExpectName: WideString;                                   // [5]
-    procedure SkipName;
     function SkipQuotedLiteral: Boolean;
     procedure ExpectAttValue;                                           // [10]
     procedure SkipPubidLiteral;                                         // [12]
@@ -409,10 +399,10 @@ type
     procedure PushVC(aElDef: TDOMElementDef);
     procedure PopVC;
     function  CurrentElementDef: TDOMElementDef;
-    procedure ValidateElement(Element: TDOMElement);
     procedure ValidateDTD;
     procedure ValidationError(const Msg: string; const args: array of const);
     procedure CheckNotation(const Name: WideString);
+    procedure DoAttrText(ch: PWideChar; Count: Integer);    
     // Some SAX-alike stuff (at a very early stage)
     procedure DoText(ch: PWideChar; Count: Integer; Whitespace: Boolean=False);
     procedure DoComment(ch: PWideChar; Count: Integer);
@@ -1038,6 +1028,24 @@ begin
 end;
 
 procedure TXMLReader.FatalError(const descr: String; AtTokenStart: Boolean);
+begin
+  DoError(esFatal, descr, AtTokenStart);
+end;
+
+procedure TXMLReader.FatalError(const descr: string; const args: array of const; AtTokenStart: Boolean);
+begin
+  DoError(esFatal, Format(descr, args), AtTokenStart);
+end;
+
+procedure TXMLReader.ValidationError(const Msg: string; const Args: array of const);
+begin
+  FDocNotValid := True;
+  if FValidate then
+  // Seems that validation errors always appear on token boundary (re-check!)
+    DoError(esError, Format(Msg, Args), True);
+end;
+
+procedure TXMLReader.DoError(Severity: TErrorSeverity; const descr: string; AtTokenStart: Boolean=False);
 var
   RealLocation: ^TLocation;
   E: EXMLReadError;
@@ -1047,16 +1055,13 @@ begin
   else
     RealLocation := @FLocation;
   E := EXMLReadError.CreateFmt('In ''%s'' (line %d pos %d): %s', [FSource.SystemID, RealLocation^.Line, RealLocation^.LinePos, descr]);
-  E.FSeverity := esFatal;
+  E.FSeverity := Severity;
   E.FErrorMessage := descr;
   E.FLine := RealLocation^.Line;
   E.FLinePos := RealLocation^.LinePos;
   CallErrorHandler(E);
-end;
-
-procedure TXMLReader.FatalError(const descr: string; const args: array of const; AtTokenStart: Boolean);
-begin
-  FatalError(Format(descr, args), AtTokenStart);
+  // No 'finally'! If user handler raises exception, control should not get here
+  E.Free;
 end;
 
 function TXMLReader.SkipWhitespace: Boolean;
@@ -1134,7 +1139,6 @@ begin
   BufAllocate(FName, 128);
   BufAllocate(FValue, 512);
   FIDRefs := TList.Create;
-  FValStack := TList.Create;
 
   // Set char rules to XML 1.0
   FNamePages := @NamePages;
@@ -1153,17 +1157,14 @@ begin
 end;
 
 destructor TXMLReader.Destroy;
-var
-  I: Integer;
 begin
   FreeMem(FName.Buffer);
   FreeMem(FValue.Buffer);
   while ContextPop do;     // clean input stack
   FSource.Free;
   FPEMap.Free;
-  for I := FValStack.Count-1 downto 0 do
-    TObject(FValStack[I]).Free;
-  FValStack.Free;
+  while Assigned(FValidator) do
+    PopVC;
   ClearIDRefs;
   FIDRefs.Free;
   inherited Destroy;
@@ -1268,12 +1269,6 @@ begin
   SetString(Result, FName.Buffer, FName.Length);
 end;
 
-procedure TXMLReader.SkipName;
-begin
-  if not CheckName then
-    RaiseNameNotFound;
-end;
-
 function TXMLReader.ResolvePredefined(const RefName: WideString): WideChar;
 begin
   if RefName = 'amp' then
@@ -1368,7 +1363,7 @@ begin
       begin
         if FValue.Length > 0 then
         begin
-          DoText(FValue.Buffer, FValue.Length);
+          DoAttrText(FValue.Buffer, FValue.Length);
           FValue.Length := 0;
         end;
 
@@ -1381,7 +1376,7 @@ begin
   end; // while
   if FValue.Length > 0 then
   begin
-    DoText(FValue.Buffer, FValue.Length);
+    DoAttrText(FValue.Buffer, FValue.Length);
     FValue.Length := 0;
   end;
 end;
@@ -1549,6 +1544,7 @@ procedure TXMLReader.ProcessTextAndRefs;
 var
   nonWs: Boolean;
   RefNode: TDOMEntityEx;
+  ElDef: TDOMElementDef;
 begin
   FValue.Length := 0;
   nonWs := False;
@@ -1573,6 +1569,12 @@ begin
     begin
       if not FInsideRoot then
         FatalError('Illegal at document level');
+      if FValidate then
+      begin
+        ElDef := CurrentElementDef;
+        if Assigned(ElDef) and (ElDef.ContentType = ctEmpty) then
+          ValidationError('References are illegal in EMPTY elements', []);
+      end;
       if ParseCharRef then
       begin
         nonWs := True; // CharRef to whitespace is not considered whitespace
@@ -1689,6 +1691,8 @@ end;
 procedure TXMLReader.ParsePI;                    // [16]
 var
   Name, Value: WideString;
+  PINode: TDOMProcessingInstruction;
+  ElDef: TDOMElementDef;
 begin
   GetCharRaw;      // skip '?'
   MarkTokenStart;
@@ -1727,8 +1731,19 @@ begin
         Dec(Length, 2);
         SetString(Value, Buffer, Length);
         // SAX: ContentHandler.ProcessingInstruction(Name, Value);
+
+        if FValidate then
+        begin
+          ElDef := CurrentElementDef;
+          if Assigned(ElDef) and (ElDef.ContentType = ctEmpty) then
+            ValidationError('Processing instructions are not allowed within EMPTY elements', []);
+        end;
+
+        PINode := Doc.CreateProcessingInstruction(Name, Value);
         if Assigned(FCursor) then
-          FCursor.AppendChild(Doc.CreateProcessingInstruction(Name, Value));
+          FCursor.AppendChild(PINode)
+        else  // to comply with certain tests, insert PI from DTD before DTD
+          Doc.InsertBefore(PINode, FDocType);
         Exit;
       end;
   until FCurChar = #0;
@@ -1820,56 +1835,51 @@ begin
 
   FDocType := TDOMDocumentTypeEx(TDOMDocumentType.Create(doc));
   FDtdParsed := True;
-{ To comply with certain output tests, we must insert PIs coming from internal
-  subset before DocType node. This looks very synthetic, but let it be...
-  Moreover, this code actually duplicates such PIs }
-  try
-    FDocType.FName := ExpectName;
-    ExpectWhitespace;
-    ParseExternalID(FDocType.FSystemID, FDocType.FPublicID, False);
-    SkipWhitespaceRaw;
+  Doc.AppendChild(FDocType);
+  FCursor := nil;
 
-    if FCurChar = '[' then
-    begin
-      BufAllocate(IntSubset, 256);
-      FCopyBuf := @IntSubset;
-      GetChar;      // cause very first char after '[' to be appended
-      try
-        FIntSubset := True;
-        ParseMarkupDecl;
-        if IntSubset.Length > 0 then  // sanity check - must at least contain ']'
-          SetString(FDocType.FInternalSubset, IntSubset.Buffer, IntSubset.Length-1);
-        ExpectChar(']');
-      finally
-        FIntSubset := False;
-        FCopyBuf := nil;
-        FreeMem(IntSubset.Buffer);
-      end;
-      SkipWhitespaceRaw;
+  FDocType.FName := ExpectName;
+  ExpectWhitespace;
+  ParseExternalID(FDocType.FSystemID, FDocType.FPublicID, False);
+  SkipWhitespaceRaw;
+
+  if FCurChar = '[' then
+  begin
+    BufAllocate(IntSubset, 256);
+    FCopyBuf := @IntSubset;
+    GetChar;      // cause very first char after '[' to be appended
+    try
+      FIntSubset := True;
+      ParseMarkupDecl;
+      if IntSubset.Length > 0 then  // sanity check - must at least contain ']'
+        SetString(FDocType.FInternalSubset, IntSubset.Buffer, IntSubset.Length-1);
+      ExpectChar(']');
+    finally
+      FIntSubset := False;
+      FCopyBuf := nil;
+      FreeMem(IntSubset.Buffer);
     end;
-    ExpectChar('>');
+    SkipWhitespaceRaw;
+  end;
+  ExpectChar('>');
 
-    if (FDocType.SystemID <> '') and ResolveEntity(FDocType.SystemID, FDocType.PublicID, Src) then
-    begin
-      // DTD parsing code assumes that FSource is RootSource,
-      // therefore we cannot use ContextPush here...
-      OldSrc := FSource;
-      UngetCurChar;
-      FCursor := nil;
-      try
-        DoParseExtSubset(Src);
-      finally
-        while ContextPop do;   // Cleanup after possible exceptions
-        FSource.Free;
-        FSource := OldSrc;
-        GetChar;
-        FCursor := Doc;
-      end;
+  if (FDocType.SystemID <> '') and ResolveEntity(FDocType.SystemID, FDocType.PublicID, Src) then
+  begin
+    // DTD parsing code assumes that FSource is RootSource,
+    // therefore we cannot use ContextPush here...
+    OldSrc := FSource;
+    UngetCurChar;
+    try
+      DoParseExtSubset(Src);
+    finally
+      while ContextPop do;   // Cleanup after possible exceptions
+      FSource.Free;
+      FSource := OldSrc;
+      GetChar;
     end;
-  finally
-    doc.AppendChild(FDocType);
   end;
-  ValidateDTD;  
+  FCursor := Doc;
+  ValidateDTD;
 end;
 
 function TXMLReader.ParseEq: Boolean;    // [25]
@@ -1972,6 +1982,7 @@ var
   CurrentEntity: TObject;
   I: Integer;
 begin
+  MarkTokenStart;
   ElName := ExpectName;
   ExpectWhitespace;
   ElDef := TDOMElementDef(FDocType.ElementDefs.GetNamedItem(ElName));
@@ -2272,7 +2283,9 @@ begin
       begin
         ExpectString('NDATA');
         ExpectWhitespace;
-        SkipName;
+        if not CheckName then
+          RaiseNameNotFound;
+
         SetString(Entity.FNotationName, FName.Buffer, FName.Length);
         // SAX: DTDHandler.UnparsedEntityDecl(...);
       end;
@@ -2414,7 +2427,7 @@ begin
   doc := TXMLDocument.Create;
   FDocType := TDOMDocumentTypeEx.Create(doc);
   // TODO: DTD labeled version 1.1 will be rejected - must set FXML11 flag
-  // TODO: what shall be FCursor? FDocType cannot - it does not accept child nodes
+  // DONE: It's ok to have FCursor=nil now
   doc.AppendChild(FDocType);
   DoParseExtSubset(ASource);
 end;
@@ -2474,7 +2487,6 @@ procedure TXMLReader.ParseElement;    // [39] [40] [44]
 var
   NewElem: TDOMElement;
   ElDef: TDOMElementDef;
-  ElVal: TElementValidator;
   IsEmpty: Boolean;
   attr, OldAttr: TDOMNode;
 begin
@@ -2485,11 +2497,7 @@ begin
 
   NewElem := doc.CreateElementBuf(FName.Buffer, FName.Length);
   // First check if NewElem is allowed in this context
-  if FValStack.Count > 0 then
-    ElVal := TElementValidator(FValStack.Last)
-  else
-    ElVal := nil;
-  if FValidate and Assigned(ElVal) and not ElVal.IsElementAllowed(NewElem.TagName) then
+  if FValidate and Assigned(FValidator) and not FValidator.IsElementAllowed(NewElem.TagName) then
     ValidationError('Element ''%s'' is not allowed in this context',[NewElem.TagName]);
 
   FCursor.AppendChild(NewElem);
@@ -2497,7 +2505,11 @@ begin
   // Then update ElementDef - it is needed to process attributes
   ElDef := nil;
   if Assigned(FDocType) then
+  begin
     ElDef := TDOMElementDef(FDocType.ElementDefs.GetNamedItem(NewElem.TagName));
+    if (ElDef = nil) or (not ElDef.HasElementDecl) then
+      ValidationError('Using undeclared element ''%s''',[NewElem.TagName]);
+  end;
 
   IsEmpty := False;
   if SkipWhitespaceRaw then
@@ -2559,8 +2571,10 @@ begin
   if FCursor = doc then
     FInsideRoot := False;
   ProcessDefaultAttributes(NewElem);
-  if FValidate then
-    ValidateElement(NewElem);
+
+  if FValidate and Assigned(FValidator) and FValidator.Incomplete then
+    ValidationError('Element ''%s'' is missing required sub-elements', [NewElem.TagName]);
+
   PopVC;
 end;
 
@@ -2700,7 +2714,8 @@ begin
   if Result then
   begin
     MarkTokenStart;
-    SkipName;
+    if not CheckName then
+      RaiseNameNotFound;
     ExpectChar(';');
   end;
 end;
@@ -2738,22 +2753,6 @@ begin
     Result := False;
 end;
 
-procedure TXMLReader.ValidationError(const Msg: string; const Args: array of const);
-var
-  E: EXMLReadError;
-begin
-  if not FValidate then
-    Exit;
-  FDocNotValid := True;
-  E := EXMLReadError.CreateFmt(Msg, Args);
-  // TODO -cErrorReporting: No location for validity errors is reported yet
-  E.FErrorMessage := E.Message;
-  E.FSeverity := esError;
-  CallErrorHandler(E);
-  // if user handler raises exception, control won't get here
-  E.Free;
-end;
-
 procedure TXMLReader.CallErrorHandler(E: EXMLReadError);
 begin
   try
@@ -2782,63 +2781,7 @@ begin
   end;
 end;
 
-procedure TXMLReader.ValidateElement(Element: TDOMElement);
-var
-  ElDef: TDOMElementDef;
-  elv: TElementValidator;
-
-  procedure Traverse(node: TDOMNode);
-  var
-    cur: TDOMNode;
-  begin
-    cur := node.FirstChild;
-    while Assigned(cur) do
-    begin
-      case cur.NodeType of
-        ELEMENT_NODE:
-          elv.AddElement(TDOMElement(cur));
-        ENTITY_REFERENCE_NODE:
-          Traverse(cur);
-        TEXT_NODE: 
-          begin
-            if not TDOMText(cur).MayBeIgnorable then
-              ValidationError('Character data is not allowed in element-only content',[])
-            else
-              if FStandalone and ElDef.FExternallyDeclared then
-                StandaloneError;
-        end;
-      end;
-      cur := cur.NextSibling;
-    end;
-  end;
-
-begin
-  ElDef := CurrentElementDef;
-  if Assigned(ElDef) and ElDef.HasElementDecl then
-  begin
-    case ElDef.ContentType of
-      ctEmpty: begin
-        if Element.HasChildNodes then
-          ValidationError('Element ''%s'' was declared empty but has content', [Element.TagName]);
-      end;
-      ctChildren: begin
-        elv := TElementValidator(FValStack.Last);
-        try
-          Traverse(Element);
-          if not elv.Match then
-            ValidationError('Content of element ''%s'' does not match its declaration',[Element.TagName]);
-        finally
-          elv.FList.Clear;
-        end;
-      end;
-    end;
-  end
-  else // if no DocType, a corresponding error will be reported.
-    if Assigned(FDocType) then
-      ValidationError('Using undeclared element ''%s''',[Element.TagName]);
-end;
-
-// TODO: this should be method of TDOMDocumentTypeEx, but we must pass ErrorHandler in... 
+// TODO: this should be method of TDOMDocumentTypeEx, but we must pass ErrorHandler in...
 procedure TXMLReader.ValidateDTD;
 var
   I, J, K: Integer;
@@ -2903,36 +2846,43 @@ end;
 procedure TXMLReader.DoText(ch: PWideChar; Count: Integer; Whitespace: Boolean);
 var
   TextNode: TDOMText;
+  ElDef: TDOMElementDef;
 begin
-  // Validating filter part (disabled for the following two reasons):
-  // TODO: per SAX, attribute text should not go here.
-  //       ElDefStack is invalid in this case, and we fail...
+  // Validating filter part
   // TODO: for testing whitespace CharRefs, they are contained in internal entities.
   //       Parsing first reports them to Entity, and then they are cloned to real parent
   //       so this method isn't called :(
-{
-  if FCursor.NodeType in [ELEMENT_NODE, ENTITY_REFERENCE_NODE] then
+
+  ElDef := CurrentElementDef;
+  if Assigned(ElDef) then
   begin
-    ElDef := CurrentElementDef;
-    if Assigned(ElDef) and (ElDef.ContentType = ctChildren) then
-    begin
-      if not Whitespace then
-         ValidationError('Character data is not allowed in element-only content',[])
-      else
-         if FStandalone and ElDef.FExternallyDeclared then
-           StandaloneError;
+    case ElDef.ContentType of
+      ctChildren:
+        if not Whitespace then
+          ValidationError('Character data is not allowed in element-only content',[])
+        else
+          if FStandalone and ElDef.FExternallyDeclared then
+            StandaloneError;
+      ctEmpty:
+        ValidationError('Character data is not allowed in EMPTY elements', []);
     end;
   end;
-}
+
   // Document builder part
   TextNode := Doc.CreateTextNodeBuf(ch, Count);
   TextNode.MayBeIgnorable := Whitespace;
   FCursor.AppendChild(TextNode);
 end;
 
+procedure TXMLReader.DoAttrText(ch: PWideChar; Count: Integer);
+begin
+  FCursor.AppendChild(Doc.CreateTextNodeBuf(ch, Count));
+end;
+
 procedure TXMLReader.DoComment(ch: PWideChar; Count: Integer);
 var
   ElDef: TDOMElementDef;
+  Node: TDOMComment;
 begin
   // validation filter part
   if FValidate then
@@ -2940,11 +2890,17 @@ begin
     ElDef := CurrentElementDef;
     if Assigned(ElDef) and (ElDef.ContentType = ctEmpty) then
       ValidationError('Comments are not allowed within EMPTY elements', []);
-  end;    
+  end;
 
   // DOM builder part
-  if (not FIgnoreComments) and Assigned(FCursor) then
-    FCursor.AppendChild(Doc.CreateCommentBuf(ch, Count));
+  if (not FIgnoreComments) then
+  begin
+    Node := Doc.CreateCommentBuf(ch, Count);
+    if Assigned(FCursor) then
+      FCursor.AppendChild(Node)
+    else
+      Doc.InsertBefore(Node, FDocType);
+  end;
 end;
 
 procedure TXMLReader.DoCDSect(ch: PWideChar; Count: Integer);
@@ -2987,26 +2943,31 @@ begin
 end;
 
 procedure TXMLReader.PushVC(aElDef: TDOMElementDef);
+var
+  v: TElementValidator;
 begin
-  FValStack.Add(TElementValidator.Create(aElDef));
+  v := TElementValidator.Create;
+  v.FElementDef := aElDef;
+  v.Parent := FValidator;
+  FValidator := v;
 end;
 
 procedure TXMLReader.PopVC;
 var
-  Validator: TObject;
+  v: TElementValidator;
 begin
-  with FValStack do
+  if Assigned(FValidator) then
   begin
-    Validator := TObject(Last);
-    Delete(Count-1);
-    Validator.Free;
+    v := FValidator.Parent;
+    FValidator.Free;
+    FValidator := v;
   end;
 end;
 
 function TXMLReader.CurrentElementDef: TDOMElementDef;
 begin
-  if FValStack.Count > 0 then
-    Result := TElementValidator(FValStack.Last).FElementDef
+  if Assigned(FValidator) then
+    Result := FValidator.FElementDef
   else
     Result := nil;
 end;
@@ -3047,83 +3008,74 @@ end;
 
 { TElementValidator }
 
-procedure TElementValidator.AddElement(aNode: TDOMElement);
-begin
-  FList.Add(aNode);
-end;
-
-constructor TElementValidator.Create(aElDef: TDOMElementDef);
-begin
-  inherited Create;
-  FElementDef := aElDef;
-  if Assigned(FElementDef) then
-    FCurCP := FElementDef.RootCP;
-  FList := TList.Create;
-end;
-
-destructor TElementValidator.Destroy;
-begin
-  FList.Free;
-  inherited Destroy;
-end;
-
 function TElementValidator.IsElementAllowed(const aName: DOMString): Boolean;
 var
   I: Integer;
+  Next: TContentParticle;
 begin
-  Inc(FChildElementCount);
   Result := True;
   // if element is not declared, non-validity has been already reported, no need to report again...
-  if FElementDef = nil then
-    Exit;
-  { for mixed content type it is easy }
-  if FElementDef.ContentType = ctMixed then
-  begin
-    for I := 0 to FElementDef.RootCP.ChildCount-1 do
-    begin
-      if aName = FElementDef.RootCP.Children[I].Name then
-        Exit;
-    end;
-    Result := False;
-    Exit;
-  end;
-  { for empty, even more easier }
-  if FElementDef.ContentType = ctEmpty then
+  if Assigned(FElementDef) then
   begin
-    Result := False;
-    Exit;
-  end;
+    case FElementDef.ContentType of
+      ctMixed: begin
+        for I := 0 to FElementDef.RootCP.ChildCount-1 do
+        begin
+          if aName = FElementDef.RootCP.Children[I].Name then
+          Exit;
+        end;
+        Result := False;
+      end;
 
+      ctEmpty: Result := False;
 
+      ctChildren: begin
+        if FCurCP = nil then
+          Next := FElementDef.RootCP.FindFirst(aName)
+        else
+          Next := FCurCP.FindNext(aName, 0); { second arg ignored here }
+        Result := Assigned(Next);
+        if Result then
+          FCurCP := Next
+        else
+          FFailed := True;  // used to prevent extra error at the end of element
+      end;
+      // ctAny: returns True by default
+    end;
+  end;
 end;
 
-function TElementValidator.Match: Boolean;
+function TElementValidator.Incomplete: Boolean;
 begin
-  FIndex := 0;
-  Result := (FElementDef.RootCP.MatchNodeList(FList, FIndex)) and (FIndex = FList.Count);
+  if Assigned(FElementDef) and (FElementDef.ContentType = ctChildren) and (not FFailed) then
+  begin
+    if FCurCP <> nil then
+      Result := FCurCP.MoreRequired(0) { arg ignored here }
+    else
+      Result := FElementDef.RootCP.IsRequired;
+  end
+  else
+    Result := False;
 end;
 
 { TContentParticle }
 
 function TContentParticle.Add: TContentParticle;
 begin
+  if FChildren = nil then
+    FChildren := TList.Create;
   Result := TContentParticle.Create;
   Result.FParent := Self;
-  FChildren.Add(Result);
-end;
-
-constructor TContentParticle.Create;
-begin
-  inherited Create;
-  FChildren := TList.Create;
+  Result.FIndex := FChildren.Add(Result);
 end;
 
 destructor TContentParticle.Destroy;
 var
   I: Integer;
 begin
-  for I := FChildren.Count-1 downto 0 do
-    TObject(FChildren[I]).Free;
+  if Assigned(FChildren) then
+    for I := FChildren.Count-1 downto 0 do
+      TObject(FChildren[I]).Free;
   FChildren.Free;
   inherited Destroy;
 end;
@@ -3135,77 +3087,90 @@ end;
 
 function TContentParticle.GetChildCount: Integer;
 begin
-  Result := FChildren.Count;
+  if Assigned(FChildren) then
+    Result := FChildren.Count
+  else
+    Result := 0;
 end;
 
-function TContentParticle.InternalMatch(List: TList; var Index: Integer): Boolean;
+function TContentParticle.IsRequired: Boolean;
 var
   I: Integer;
-  TempIndex, RestIndex, MatchNumber: Integer;
 begin
-  if CPType = ctName then
+  Result := (CPQuant = cqOnce) or (CPQuant = cqOnceOrMore);
+  // do not return True if all children are optional
+  if (CPType <> ctName) and Result then
   begin
-    Result := (Index < List.Count) and (TDOMElement(List[Index]).TagName = Name);
-    if Result then
-      Inc(Index);
-  end
-  else if CPType = ctChoice then
-  begin
-    RestIndex := Index;
-    Result := False;
-    MatchNumber := 0;
     for I := 0 to ChildCount-1 do
     begin
-      TempIndex := Index;
-      if Children[I].MatchNodeList(List, TempIndex) then
-      begin
-        Result := True;
-        if Index <> TempIndex then  // Do not count matching empty expressions
-        begin
-          Inc(MatchNumber);
-          if MatchNumber > 1 then
-            Break;
-          RestIndex := TempIndex;
-        end;
-      end else if MatchNumber > 1 then Break;
+      Result := Children[I].IsRequired;
+      if Result then Exit;
     end;
+  end;
+end;
 
-    if Result then
-      Index := RestIndex;
-  end
-  else // ctSeq
+function TContentParticle.MoreRequired(ChildIdx: Integer): Boolean;
+var
+  I: Integer;
+begin
+  Result := False;
+  if CPType = ctSeq then
   begin
-    MatchNumber := 0;
-    TempIndex := Index;
-    Result := False;
-    for I := 0 to ChildCount-1 do
+    for I := ChildIdx + 1 to ChildCount-1 do
     begin
-      Result := Children[I].MatchNodeList(List, TempIndex);
-      if not Result then Break;
+      Result := Children[I].IsRequired;
+      if Result then Exit;
     end;
+  end;
+  if Assigned(FParent) then
+    Result := FParent.MoreRequired(FIndex);
+end;
 
-    if Result then
-      Index := TempIndex;
-    if MatchNumber > 1 then
-      Result := False;
+function TContentParticle.FindFirst(const aName: DOMString): TContentParticle;
+var
+  I: Integer;
+begin
+  Result := nil;
+  case CPType of
+    ctSeq:
+      for I := 0 to ChildCount-1 do with Children[I] do
+      begin
+        Result := FindFirst(aName);
+        if Assigned(Result) or IsRequired then
+          Exit;
+      end;
+    ctChoice:
+      for I := 0 to ChildCount-1 do with Children[I] do
+      begin
+        Result := FindFirst(aName);
+        if Assigned(Result) then
+          Exit;
+      end;
+  else // ctName
+    if aName = Self.Name then
+      Result := Self
   end;
 end;
 
-function TContentParticle.MatchNodeList(List: TList; var Index: Integer): Boolean;
+function TContentParticle.FindNext(const aName: DOMString;
+  ChildIdx: Integer): TContentParticle;
 var
-  Saved: Integer;
+  I: Integer;
 begin
-  Result := InternalMatch(List, Index) or not (CPQuant in [cqOnce, cqOnceOrMore]);
-  if Result and (CPQuant in [cqZeroOrMore, cqOnceOrMore]) then
+  Result := nil;
+  if CPType = ctSeq then   // search sequence to its end
   begin
-    Saved := Index;
-    while Index < List.Count do
+    for I := ChildIdx + 1 to ChildCount-1 do with Children[I] do
     begin
-      if not InternalMatch(List, Saved) or (Index = Saved) then
-        Break;
-      Index := Saved;
+      Result := FindFirst(aName);
+      if (Result <> nil) or IsRequired then
+        Exit;
     end;
   end;
+  if (CPQuant = cqZeroOrMore) or (CPQuant = cqOnceOrMore) then
+    Result := FindFirst(aName);
+  if (Result = nil) and Assigned(FParent) then
+    Result := FParent.FindNext(aName, FIndex);
 end;
 
 { TDOMElementDef }

packages/fcl-xml/src/xmlutils.pp

@@ -184,10 +184,10 @@ var
   I: Integer;
 begin
   Result := False;
-  if (Value = '') or (Value[1] > #255) or not (char(Value[1]) in ['A'..'Z', 'a'..'z']) then
+  if (Value = '') or (Value[1] > #255) or not (char(ord(Value[1])) in ['A'..'Z', 'a'..'z']) then
     Exit;
   for I := 2 to Length(Value) do
-    if (Value[I] > #255) or not (char(Value[I]) in ['A'..'Z', 'a'..'z', '0'..'9', '.', '_', '-']) then
+    if (Value[I] > #255) or not (char(ord(Value[I])) in ['A'..'Z', 'a'..'z', '0'..'9', '.', '_', '-']) then
       Exit;
   Result := True;
 end;

packages/fcl-xml/tests/xmlts.pp

@@ -139,7 +139,8 @@ procedure TTestSuite.ErrorHandler(Error: EXMLReadError);
 begin
   if Error.Severity = esError then
   begin
-    FValError := Error.Message;
+    if FValError = '' then // fetch the _first_ message
+      FValError := Error.Message;
 { uncomment the line below to verify that the suite correctly handles
   exception raised from the handler }    
 //  Abort;  
@@ -351,16 +352,11 @@ begin
 
   table := nil;
   outURI := '';
+  Positive := False;
   if TestType = 'not-wf' then
-  begin
-    table := table_not_wf;
-    Positive := False;
-  end
+    table := table_not_wf
   else if TestType = 'error' then
-  begin
-    table := table_informative;
-    Positive := False;
-  end
+    table := table_informative
   else if TestType = 'valid' then
   begin
     if Element.hasAttribute('OUTPUT') then
@@ -393,30 +389,45 @@ begin
         if E.ClassType <> EAbort then
           FailMsg := E.Message;
     end;
-    if FailMsg <> '' then  // fatal errors take precedence
-      FValError := '';
+
+    if table = table_informative then
+    begin
+      if FailMsg <> '' then
+        Diagnose(element, table, dcInfo, '(fatal) ' + FailMsg)
+      else if FValError <> '' then
+        Diagnose(element, table, dcInfo, '(error) ' + FValError)
+      else
+        Diagnose(Element, table, dcInfo, '');
+      Exit;
+    end;
 
     if not Positive then  // must have been failed
     begin
-      if TestType = 'error' then
-      begin
-        if FailMsg <> '' then
-          Diagnose(element, table, dcInfo, FailMsg)
-        else
-          Diagnose(element, table, dcInfo, FValError);
-      end
-      else if (FailMsg = '') and (FValError = '') then
+      if (FailMsg = '') and (FValError = '') then
       begin
         Inc(FFailCount);
         Diagnose(element, table, dcNegfail, '');
       end
       else // FailMsg <> '' or FValError <> '' -> actually failed
       begin
-        Inc(FFalsePasses);
-        if FailMsg <> '' then
-          Diagnose(Element, table, dcPass, FailMsg)
+        if FailMsg <> '' then  // Fatal error
+        begin
+          Inc(FFalsePasses);
+          Diagnose(Element, table, dcPass, FailMsg);
+        end
         else
-          Diagnose(Element, table, dcPass, FValError);
+        begin
+          if table = table_not_wf then  // validation error here is a test failure!
+          begin
+            Inc(FFailCount);
+            Diagnose(Element, table, dcFail, FValError);
+          end
+          else
+          begin
+            Inc(FFalsePasses);
+            Diagnose(Element, table, dcPass, FValError);
+          end;
+        end;
       end;
       Exit;
     end

rtl/objpas/sysutils/sysstrh.inc

@@ -39,8 +39,8 @@ type
    End;
 
 const
-  { For floattodatetime }
-  MinDateTime: TDateTime = -657434.0;      { 01/01/0100 12:00:00.000 AM }
+  { For floattodatetime and VariantToDate }
+  MinDateTime: TDateTime =  -693593.0;     { 01/01/0001 12:00:00.000 AM }
   MaxDateTime: TDateTime =  2958465.99999; { 12/31/9999 11:59:59.999 PM }
 
 {$if defined(FPC_HAS_TYPE_EXTENDED) or defined(FPC_HAS_TYPE_FLOAT128)}