Merged revisions 12210-12306 via svnmerge from

svn+ssh://[email protected]/FPC/svn/fpc/trunk

git-svn-id: branches/wpo@12307 -

.gitattributes

@@ -911,6 +911,8 @@ packages/aspell/Makefile.fpc svneol=native#text/plain
 packages/aspell/examples/example.pas svneol=native#text/plain
 packages/aspell/fpmake.pp svneol=native#text/plain
 packages/aspell/src/aspell.pp svneol=native#text/plain
+packages/aspell/src/aspelldyn.pp svneol=native#text/plain
+packages/aspell/src/aspelltypes.inc svneol=native#text/plain
 packages/aspell/src/spellcheck.pp svneol=native#text/plain
 packages/bfd/Makefile svneol=native#text/plain
 packages/bfd/Makefile.fpc svneol=native#text/plain
@@ -1703,6 +1705,7 @@ packages/fv/src/amismsg.inc svneol=native#text/plain
 packages/fv/src/app.pas svneol=native#text/plain
 packages/fv/src/asciitab.pas svneol=native#text/plain
 packages/fv/src/buildfv.pas svneol=native#text/plain
+packages/fv/src/colorsel.pas svneol=native#text/plain
 packages/fv/src/colortxt.pas svneol=native#text/plain
 packages/fv/src/dialogs.pas svneol=native#text/plain
 packages/fv/src/drivers.pas svneol=native#text/plain
@@ -7591,6 +7594,12 @@ tests/test/opt/treg3.pp svneol=native#text/plain
 tests/test/opt/treg4.pp svneol=native#text/plain
 tests/test/opt/tretopt.pp svneol=native#text/plain
 tests/test/opt/tspace.pp svneol=native#text/plain
+tests/test/packages/fcl-base/tgettext1.pp svneol=native#text/plain
+tests/test/packages/fcl-db/assertions.pas svneol=native#text/plain
+tests/test/packages/fcl-db/dbftoolsunit.pas svneol=native#text/plain
+tests/test/packages/fcl-db/tdb1.pp svneol=native#text/plain
+tests/test/packages/fcl-db/tdb2.pp svneol=native#text/plain
+tests/test/packages/fcl-db/toolsunit.pas svneol=native#text/plain
 tests/test/packages/fcl-registry/tregistry1.pp svneol=native#text/plain
 tests/test/packages/hash/tmdtest.pp svneol=native#text/plain
 tests/test/packages/webtbs/tw10045.pp svneol=native#text/plain

compiler/pdecobj.pas

@@ -720,7 +720,9 @@ implementation
            ) then
           current_objectdef.insertvmt;
 
+        { for implemented classes with a vmt check if there is a constructor }
         if (oo_has_vmt in current_objectdef.objectoptions) and
+           not(oo_is_forward in current_objectdef.objectoptions) and
            not(oo_has_constructor in current_objectdef.objectoptions) then
           Message1(parser_w_virtual_without_constructor,current_objectdef.objrealname^);
 

ide/fpini.pas

@@ -31,7 +31,7 @@ procedure SetPrinterDevice(const Device: string);
 
 implementation
 
-uses
+uses 
   Dos,Objects,Drivers,
   FVConsts,
   Version,
@@ -362,6 +362,7 @@ var INIFile: PINIFile;
     OK: boolean;
     ts : TSwitchMode;
     W: word;
+    crcv:cardinal;
 begin
   OK:=ExistsFile(IniFileName);
   if OK then
@@ -432,10 +433,12 @@ begin
   CtrlMouseAction:=INIFile^.GetIntEntry(secMouse,ieCtrlClickAction,CtrlMouseAction);
   {Keyboard}
   S:=upcase(INIFile^.GetEntry(secKeyboard,ieEditKeys,''));
-  case UpdateCrc32(0,s[1],Length(s)) of
-    $86a4c898: {crc32 for 'MICROSOFT'}
+  crcv := UpdateCrc32(0,s[1],Length(s)) ;
+  case crcv of
+    $795B3767  : {crc32 for 'MICROSOFT'}
       EditKeys:=ekm_microsoft;
-    $b20b87b3: {crc32 for 'BORLAND'}
+    $4DF4784C
+       : {crc32 for 'BORLAND'}
       EditKeys:=ekm_borland;
     else
       EditKeys:=ekm_default;

packages/aspell/Makefile

@@ -1,5 +1,5 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2008/10/22]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2008/11/27]
 #
 default: all
 MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded avr-embedded armeb-linux armeb-embedded
@@ -265,178 +265,178 @@ PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages $(FPCDIR)/packages/base $(F
 override PACKAGE_NAME=aspell
 override PACKAGE_VERSION=2.2.2
 ifeq ($(FULL_TARGET),i386-linux)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),i386-go32v2)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),i386-win32)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),i386-os2)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),i386-freebsd)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),i386-beos)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),i386-haiku)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),i386-netbsd)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),i386-solaris)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),i386-qnx)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),i386-netware)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),i386-openbsd)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),i386-wdosx)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),i386-darwin)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),i386-emx)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),i386-watcom)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),i386-netwlibc)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),i386-wince)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),i386-embedded)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),i386-symbian)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),m68k-linux)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),m68k-freebsd)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),m68k-netbsd)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),m68k-amiga)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),m68k-atari)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),m68k-openbsd)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),m68k-palmos)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),m68k-embedded)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),powerpc-linux)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),powerpc-netbsd)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),powerpc-amiga)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),powerpc-macos)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),powerpc-darwin)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),powerpc-morphos)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),powerpc-embedded)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),sparc-linux)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),sparc-netbsd)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),sparc-solaris)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),sparc-embedded)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),x86_64-linux)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),x86_64-darwin)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),x86_64-win64)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),x86_64-embedded)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),arm-linux)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),arm-palmos)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),arm-darwin)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),arm-wince)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),arm-gba)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),arm-nds)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),arm-embedded)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),arm-symbian)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),powerpc64-linux)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),powerpc64-darwin)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),powerpc64-embedded)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),avr-embedded)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),armeb-linux)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 ifeq ($(FULL_TARGET),armeb-embedded)
-override TARGET_UNITS+=aspell spellcheck
+override TARGET_UNITS+=aspell aspelldyn spellcheck
 endif
 override INSTALL_FPCPACKAGE=y
 ifeq ($(FULL_TARGET),i386-linux)

packages/aspell/Makefile.fpc

@@ -7,7 +7,7 @@ name=aspell
 version=2.2.2
 
 [target]
-units=aspell spellcheck
+units=aspell aspelldyn spellcheck
 
 [install]
 fpcpackage=y

packages/aspell/examples/example.pas

@@ -3,24 +3,32 @@ program Example;
 {$mode objfpc}{$H+}
 
 uses
-  sCheck;
+  SpellCheck;
 
 var
-  i, j, n: Integer;
+  i, j: Integer;
   s: TSuggestionArray; { in case the word is wrong, this array contains
                          a list of suggestions }
+  Speller: TWordSpeller;
 begin
   if Paramcount < 2 then // check if user has used valid input
     Writeln('Usage: ', ParamStr(0), ' <lang> <word1> <word2> ...')
-  else for i := 2 to ParamCount do begin // go for each word specified
-    n := SpellCheck(ParamStr(i), ParamStr(1), s); // spellcheck each word
-    if n > 0 then begin // if n > 0 then the word is wrong and we need to write suggestions
-      Write(ParamStr(i), ' is wrong. Here are some suggestions: ');
-      for j := 0 to High(s) do
-        Write(s[j], ' '); // write out the suggestions
-      Writeln; // to keep format
-    end else
-      Writeln(ParamStr(i), ' is spelled correctly!');
+  else begin
+    Speller := TWordSpeller.Create;
+    Speller.Language := ParamStr(1);
+
+    for i := 2 to ParamCount do begin // go for each word specified
+      s := Speller.SpellCheck(ParamStr(i)); // spellcheck each word
+      if Length(s) > 0 then begin // we need to write suggestions
+        Write(ParamStr(i), ' is wrong. Here are some suggestions: ');
+        for j := 0 to High(s) do
+          Write(s[j], ' '); // write out the suggestions
+        Writeln; // to keep format
+      end else
+        Writeln(ParamStr(i), ' is spelled correctly!');
+    end;
+
+    Speller.Free;
   end;
 end.
 

packages/aspell/fpmake.pp

@@ -28,6 +28,7 @@ begin
     P.SourcePath.Add('src');
 
     T:=P.Targets.AddUnit('aspell.pp');
+    T:=P.Targets.AddUnit('aspelldyn.pp');
     T:=P.Targets.AddUnit('spellcheck.pp');
     with T.Dependencies do
       begin

packages/aspell/src/aspell.pp

@@ -15,156 +15,14 @@ interface
 uses
   cTypes;
 
-{$IFDEF Linux}
-  const libaspell = '/usr/lib/libaspell.so';
+{$IFDEF UNIX}
+  const libaspell = 'aspell';
+{$ELSE} // windows
+  // TODO: figure this out
+  const libaspell = 'aspell-%s.dll';
 {$ENDIF}
 
-{$IFDEF FreeBSD}
-  const libaspell = '/usr/local/lib/libaspell.so';
-{$ENDIF}
-
-{$IFDEF darwin}
- const libaspell = '/opt/local/lib/libaspell.dylib';
-{$ENDIF}
-
-{$IFDEF windows}
- const libaspell = 'aspell-%s.dll';
-{$ENDIF}
-
-{$IFDEF BeOS}
- const libaspell = '/boot/home/config/lib/libaspell.so';
-{$ENDIF}
-
-{$IFDEF Solaris}
- const libaspell = '/opt/csw/lib/libpspell.so.15';
-{$ENDIF}
-
-{$IFDEF SkyOS}
- {$DEFINE STATIC_ASPELL}
- {$LINKLIB aspell}
- const libaspell = 'aspell';
-{$ENDIF}
-
-    type
-      PAspellCanHaveError  = Pointer;
-      PAspellConfig  = Pointer;
-      PAspellDictInfoEnumeration  = Pointer;
-      PAspellDictInfoList  = Pointer;
-      PAspellDocumentChecker  = Pointer;
-      PAspellFilter  = Pointer;
-      PAspellKeyInfoEnumeration  = Pointer;
-      PAspellModuleInfoEnumeration  = Pointer;
-      PAspellModuleInfoList  = Pointer;
-      PAspellMutableContainer  = Pointer;
-      PAspellSpeller  = Pointer;
-      PAspellStringEnumeration  = Pointer;
-      PAspellStringList  = Pointer;
-      PAspellStringMap  = Pointer;
-      PAspellStringPairEnumeration  = Pointer;
-      PAspellWordList  = Pointer;
-
-  {****************************** type id ****************************** }
-
-   type
-     PAspellTypeId = ^AspellTypeId;
-     AspellTypeId = record
-         case longint of
-            0 : ( num : cuint );
-            1 : ( str : array[0..3] of char );
-         end;
-         
-    {****************************** key info ****************************** }
-
-       PAspellKeyInfoType = ^AspellKeyInfoType;
-       AspellKeyInfoType = (AspellKeyInfoString,AspellKeyInfoInt,
-         AspellKeyInfoBool,AspellKeyInfoList
-         );
-
-    { A brief description of the key or NULL if internal value.  }
-
-       PAspellKeyInfo = ^AspellKeyInfo;
-       AspellKeyInfo = record
-            name : pchar;
-            _type : AspellKeyInfoType;
-            def : pchar;
-            desc : pchar;
-            flags : cint;
-            other_data : cint;
-         end;
-
-    {****************************** error ****************************** }
-  
-       PAspellErrorInfo = ^AspellErrorInfo;
-       AspellErrorInfo = record
-            isa : PAspellErrorInfo;
-            mesg : pchar;
-            num_parms : cuint;
-            parms : array[0..2] of pchar;
-         end;
-         
-       PAspellError = ^AspellError;
-       AspellError = record
-            mesg : pchar;
-            err : PAspellErrorInfo;
-         end;
-         
-    {****************************** token ****************************** }
-
-       PAspellToken = ^AspellToken;
-       AspellToken = record
-            offset : cuint;
-            len : cuint;
-         end;
-
-    {*************************** module/dict *************************** }
-
-       PAspellModuleInfo = ^AspellModuleInfo;
-       AspellModuleInfo = record
-            name : pchar;
-            order_num : double;
-            lib_dir : pchar;
-            dict_dirs : PAspellStringList;
-            dict_exts : PAspellStringList;
-         end;
-
-    { The Name to identify this dictionary by.  }
-
-    { The language code to identify this dictionary.
-       * A two letter UPPER-CASE ISO 639 language code
-       * and an optional two letter ISO 3166 country
-       * code after a dash or underscore.  }
-
-    { Any extra information to distinguish this
-       * variety of dictionary from other dictionaries
-       * which may have the same language and size.  }
-
-    { A two char digit code describing the size of
-       * the dictionary: 10=tiny, 20=really small,
-       * 30=small, 40=med-small, 50=med, 60=med-large,
-       * 70=large, 80=huge, 90=insane.  Please check
-       * the README in aspell-lang-200?????.tar.bz2 or
-       * see SCOWL (http://wordlist.sourceforge.net)
-       * for an example of how these sizes are used.  }
-
-       PAspellDictInfo = ^AspellDictInfo;
-       AspellDictInfo = record
-            name : pchar;
-            code : pchar;
-            jargon : pchar;
-            size : cint;
-            size_str : pchar;
-            module : PAspellModuleInfo;
-         end;
-
-  {**************************** string pair **************************** }
-
-       PAspellStringPair = ^AspellStringPair;
-       AspellStringPair = record
-            first : pchar;
-            second : pchar;
-         end;
-         
-{$IFDEF STATIC_ASPELL}
+  {$i aspelltypes.inc}
 
   {************************* mutable container ************************* }
 
@@ -570,422 +428,12 @@ uses
 
     function aspell_reset_cache(which:pchar):cint;cdecl;external libaspell name 'aspell_reset_cache';
     
-{$ELSE}
-
-  {************************* mutable container ************************* }
-var
-  aspell_mutable_container_add: function(ths:PAspellMutableContainer; to_add:pchar):cint;cdecl;
-
-  aspell_mutable_container_remove: function(ths:PAspellMutableContainer; to_rem:pchar):cint;cdecl;
-
-  aspell_mutable_container_clear: procedure(ths:PAspellMutableContainer);cdecl;
-
-  aspell_mutable_container_to_mutable_container: function(ths:PAspellMutableContainer):PAspellMutableContainer;cdecl;
-
-      {******************************* config ******************************* }
-
-  aspell_key_info_enumeration_at_end: function(ths:PAspellKeyInfoEnumeration):cint;cdecl;
-
-  aspell_key_info_enumeration_next: function(ths:PAspellKeyInfoEnumeration):PAspellKeyInfo;cdecl;
-
-  delete_aspell_key_info_enumeration: procedure(ths:PAspellKeyInfoEnumeration);cdecl;
-
-  aspell_key_info_enumeration_clone: function(ths:PAspellKeyInfoEnumeration):PAspellKeyInfoEnumeration;cdecl;
-
-  aspell_key_info_enumeration_assign: procedure(ths:PAspellKeyInfoEnumeration; other:PAspellKeyInfoEnumeration);cdecl;
-
-  new_aspell_config: function():PAspellConfig;cdecl;
-
-  delete_aspell_config: procedure(ths:PAspellConfig);cdecl;
-
-  aspell_config_clone: function(ths:PAspellConfig):PAspellConfig;cdecl;
-
-  aspell_config_assign: procedure(ths:PAspellConfig; other:PAspellConfig);cdecl;
-
-  aspell_config_error_number: function(ths:PAspellConfig):cuint;cdecl;
-
-  aspell_config_error_message: function(ths:PAspellConfig):pchar;cdecl;
-
-  aspell_config_error: function(ths:PAspellConfig):PAspellError;cdecl;
-
-      { Sets extra keys which this config class should
-       * accept. begin and end are expected to point to
-       * the beginning and ending of an array of Aspell
-       * Key Info.  }
-
-  aspell_config_set_extra: procedure(ths:PAspellConfig; b:PAspellKeyInfo; e:PAspellKeyInfo);cdecl;
-
-      { Returns the KeyInfo object for the
-       * corresponding key or returns NULL and sets
-       * error_num to PERROR_UNKNOWN_KEY if the key is
-       * not valid. The pointer returned is valid for
-       * the lifetime of the object.  }
-
-  aspell_config_keyinfo: function(ths:PAspellConfig; key:pchar):PAspellKeyInfo;cdecl;
-
-      { Returns a newly allocated enumeration of all
-       * the possible objects this config class uses.  }
-
-  aspell_config_possible_elements: function(ths:PAspellConfig; include_extra:cint):PAspellKeyInfoEnumeration;cdecl;
-
-      { Returns the default value for given key which
-       * may involve substituting variables, thus it is
-       * not the same as keyinfo(key)->def returns NULL
-       * and sets error_num to PERROR_UNKNOWN_KEY if
-       * the key is not valid. Uses the temporary
-       * string.  }
-
-  aspell_config_get_default: function(ths:PAspellConfig; key:pchar):pchar;cdecl;
-
-      { Returns a newly allocated enumeration of all
-       * the key/value pairs. This DOES not include ones
-       * which are set to their default values.  }
-
-  aspell_config_elements: function(ths:PAspellConfig):PAspellStringPairEnumeration;cdecl;
-
-      { Inserts an item, if the item already exists it
-       * will be replaced. Returns TRUE if it succeeded
-       * or FALSE on error. If the key is not valid it
-       * sets error_num to PERROR_UNKNOWN_KEY, if the
-       * value is not valid it will set error_num to
-       * PERROR_BAD_VALUE, if the value can not be
-       * changed it sets error_num to
-       * PERROR_CANT_CHANGE_VALUE, and if the value is
-       * a list and you are trying to set its directory,
-       * it sets error_num to PERROR_LIST_SET  }
-
-  aspell_config_replace: function(ths:PAspellConfig; key:pchar; value:pchar):cint;cdecl;
-
-      { Remove a key and returns TRUE if it exists
-       * otherwise return FALSE. This effectively sets
-       * the key to its default value. Calling replace
-       * with a value of "<default>" will also call
-       * remove. If the key does not exist then it sets
-       * error_num to 0 or PERROR_NOT, if the key is
-       * not valid then it sets error_num to
-       * PERROR_UNKNOWN_KEY, if the value can not be
-       * changed then it sets error_num to
-       * PERROR_CANT_CHANGE_VALUE  }
-
-  aspell_config_remove: function(ths:PAspellConfig; key:pchar):cint;cdecl;
-
-  aspell_config_have: function(ths:PAspellConfig; key:pchar):cint;cdecl;
-
-      { Returns NULL on error.  }
-
-  aspell_config_retrieve: function(ths:PAspellConfig; key:pchar):pchar;cdecl;
-
-  aspell_config_retrieve_list: function(ths:PAspellConfig; key:pchar; lst:PAspellMutableContainer):cint;cdecl;
-
-      { In "ths" Aspell configuration, search for a
-       * character string matching "key" string.
-       * If "key" is found then return 1 else return 0.
-       * If error encountered, then return -1.  }
-
-  aspell_config_retrieve_bool: function(ths:PAspellConfig; key:pchar):cint;cdecl;
-
-      { In "ths" Aspell configuration, search for an
-       * integer value matching "key" string.
-       * Return -1 on error.  }
-
-  aspell_config_retrieve_int: function(ths:PAspellConfig; key:pchar):cint;cdecl;
-
-      {******************************* error ******************************* }
-
-  aspell_error_is_a: function(ths:PAspellError; e:PAspellErrorInfo):cint;cdecl;
-
-      {*************************** can have error *************************** }
-
-  aspell_error_number: function(ths:PAspellCanHaveError):cuint;cdecl;
-
-  aspell_error_message: function(ths:PAspellCanHaveError):pchar;cdecl;
-
-  aspell_error: function(ths:PAspellCanHaveError):PAspellError;cdecl;
-
-  delete_aspell_can_have_error: procedure(ths:PAspellCanHaveError);cdecl;
-
-      {******************************* errors ******************************* }
-
-      // ignored
-
-      {****************************** speller ****************************** }
-
-  new_aspell_speller: function(config:PAspellConfig):PAspellCanHaveError;cdecl;
-
-  to_aspell_speller: function(obj:PAspellCanHaveError):PAspellSpeller;cdecl;
-
-  delete_aspell_speller: procedure(ths:PAspellSpeller);cdecl;
-
-  aspell_speller_error_number: function(ths:PAspellSpeller):cuint;cdecl;
-
-  aspell_speller_error_message: function(ths:PAspellSpeller):pchar;cdecl;
-
-  aspell_speller_error: function(ths:PAspellSpeller):PAspellError;cdecl;
-
-  aspell_speller_config: function(ths:PAspellSpeller):PAspellConfig;cdecl;
-      { Returns 0 if it is not in the dictionary,
-       * 1 if it is, or -1 on error.  }
-
-  aspell_speller_check: function(ths:PAspellSpeller; word:pchar; word_size:cint):cint;cdecl;
-
-      { Add this word to your own personal word list.  }
-
-  aspell_speller_add_to_personal: function(ths:PAspellSpeller; word:pchar; word_size:cint):cint;cdecl;
-
-      { Add this word to the current spelling session.  }
-
-  aspell_speller_add_to_session: function(ths:PAspellSpeller; word:pchar; word_size:cint):cint;cdecl;
-
-      { This is your own personal word list file plus
-       * any extra words added during this session to
-       * your own personal word list.  }
-
-  aspell_speller_personal_word_list: function(ths:PAspellSpeller):PAspellWordList;cdecl;
-
-      { This is a list of words added to this session
-       * that are not in the main word list or in your
-       * own personal list but are considered valid for
-       * this spelling session.  }
-
-  aspell_speller_session_word_list: function(ths:PAspellSpeller):PAspellWordList;cdecl;
-
-      { This is the main list of words used during this
-       * spelling session.  }
-
-  aspell_speller_main_word_list: function(ths:PAspellSpeller):PAspellWordList;cdecl;
-
-  aspell_speller_save_all_word_lists: function(ths:PAspellSpeller):cint;cdecl;
-
-  aspell_speller_clear_session: function(ths:PAspellSpeller):cint;cdecl;
-
-      { Return NULL on error.
-       * The word list returned by suggest is only
-       * valid until the next call to suggest.  }
-
-  aspell_speller_suggest: function(ths:PAspellSpeller; word:pchar; word_size:cint):PAspellWordList;cdecl;
-
-  aspell_speller_store_replacement: function(ths:PAspellSpeller; mis:pchar; mis_size:cint; cor:pchar; cor_size:cint):cint;cdecl;
-
-      {******************************* filter ******************************* }
-
-  delete_aspell_filter: procedure(ths:PAspellFilter);cdecl;
-
-  aspell_filter_error_number: function(ths:PAspellFilter):cuint;cdecl;
-
-  aspell_filter_error_message: function(ths:PAspellFilter):pchar;cdecl;
-
-  aspell_filter_error: function(ths:PAspellFilter):PAspellError;cdecl;
-
-  to_aspell_filter: function(obj:PAspellCanHaveError):PAspellFilter;cdecl;
-
-      {************************** document checker ************************** }
-
-  delete_aspell_document_checker: procedure(ths:PAspellDocumentChecker);cdecl;
-
-  aspell_document_checker_error_number: function(ths:PAspellDocumentChecker):cuint;cdecl;
-
-  aspell_document_checker_error_message: function(ths:PAspellDocumentChecker):pchar;cdecl;
-
-  aspell_document_checker_error: function(ths:PAspellDocumentChecker):PAspellError;cdecl;
-
-      { Creates a new document checker.
-       * The speller class is expected to last until
-       * this class is destroyed.
-       * If config is given it will be used to override
-       * any relevent options set by this speller class.
-  is: function done.cdecl;
-       * If filter is given then it will take ownership of
-       * the filter class and use it to do the filtering.
-       * You are expected to free the checker when done.  }
-
-  new_aspell_document_checker: function(speller: PAspellSpeller): PAspellCanHaveError;cdecl;
-
-  to_aspell_document_checker: function(obj:PAspellCanHaveError):PAspellDocumentChecker;cdecl;
-
-      { Reset the internal state of the filter.
-       * Should be called whenever a new document is
-       * being filtered.  }
-  aspell_document_checker_reset: procedure(ths:PAspellDocumentChecker);cdecl;
-
-      { Process a string.
-       * The string passed in should only be split on
-       * white space characters.  Furthermore, between
-       * calls to reset, each string should be passed
-       * in exactly once and in the order they appeared
-       * in the document.  Passing in strings out of
-       * order, skipping strings or passing them in
-       * more than once may lead to undefined results.  }
-
-  aspell_document_checker_process: procedure(ths:PAspellDocumentChecker; str:pchar; size:cint);cdecl;
-
-      { Returns the next misspelled word in the
-       * processed string.  If there are no more
-       * misspelled words, then token.word will be
-       * NULL and token.size will be 0  }
-
-  // hack around struct/cdecl problem
-  __aspell_document_checker_next_misspelling: function(ths:PAspellDocumentChecker):{$IFDEF CPU64}{$IFDEF LINUX}QWord{$ELSE}AspellToken{$ENDIF}{$ELSE}AspellToken{$ENDIF};cdecl;
-
-      { Returns the underlying filter class.  }
-
-  aspell_document_checker_filter: function(ths:PAspellDocumentChecker):PAspellFilter;cdecl;
-
-      {***************************** word list ***************************** }
-
-  aspell_word_list_empty: function(ths:PAspellWordList):cint;cdecl;
-
-  aspell_word_list_size: function(ths:PAspellWordList):cuint;cdecl;
-
-  aspell_word_list_elements: function(ths:PAspellWordList):PAspellStringEnumeration;cdecl;
-
-      {************************* string enumeration ************************* }
-
-  delete_aspell_string_enumeration: procedure(ths:PAspellStringEnumeration);cdecl;
-
-  aspell_string_enumeration_clone: function(ths:PAspellStringEnumeration):PAspellStringEnumeration;cdecl;
-
-  aspell_string_enumeration_assign: procedure(ths:PAspellStringEnumeration; other:PAspellStringEnumeration);cdecl;
-
-  aspell_string_enumeration_at_end: function(ths:PAspellStringEnumeration):cint;cdecl;
-
-  aspell_string_enumeration_next: function(ths:PAspellStringEnumeration):pchar;cdecl;
-
-      {******************************** info ******************************** }
-
-  get_aspell_module_info_list: function(config:PAspellConfig):PAspellModuleInfoList;cdecl;
-
-  aspell_module_info_list_empty: function(ths:PAspellModuleInfoList):cint;cdecl;
-
-  aspell_module_info_list_size: function(ths:PAspellModuleInfoList):cuint;cdecl;
-
-  aspell_module_info_list_elements: function(ths:PAspellModuleInfoList):PAspellModuleInfoEnumeration;cdecl;
-
-  get_aspell_dict_info_list: function(config:PAspellConfig):PAspellDictInfoList;cdecl;
-
-  aspell_dict_info_list_empty: function(ths:PAspellDictInfoList):cint;cdecl;
-
-  aspell_dict_info_list_size: function(ths:PAspellDictInfoList):cuint;cdecl;
-
-  aspell_dict_info_list_elements: function(ths:PAspellDictInfoList):PAspellDictInfoEnumeration;cdecl;
-
-  aspell_module_info_enumeration_at_end: function(ths:PAspellModuleInfoEnumeration):cint;cdecl;
-
-  aspell_module_info_enumeration_next: function(ths:PAspellModuleInfoEnumeration):PAspellModuleInfo;cdecl;
-
-  delete_aspell_module_info_enumeration: procedure(ths:PAspellModuleInfoEnumeration);cdecl;
-
-  aspell_module_info_enumeration_clone: function(ths:PAspellModuleInfoEnumeration):PAspellModuleInfoEnumeration;cdecl;
-
-  aspell_module_info_enumeration_assign: procedure(ths:PAspellModuleInfoEnumeration; other:PAspellModuleInfoEnumeration);cdecl;
-
-  aspell_dict_info_enumeration_at_end: function(ths:PAspellDictInfoEnumeration):cint;cdecl;
-
-  aspell_dict_info_enumeration_next: function(ths:PAspellDictInfoEnumeration):PAspellDictInfo;cdecl;
-
-  delete_aspell_dict_info_enumeration: procedure(ths:PAspellDictInfoEnumeration);cdecl;
-
-  aspell_dict_info_enumeration_clone: function(ths:PAspellDictInfoEnumeration):PAspellDictInfoEnumeration;cdecl;
-
-  aspell_dict_info_enumeration_assign: procedure(ths:PAspellDictInfoEnumeration; other:PAspellDictInfoEnumeration);cdecl;
-
-      {**************************** string list **************************** }
-
-  new_aspell_string_list: function():PAspellStringList;cdecl;
-
-  aspell_string_list_empty: function(ths:PAspellStringList):cint;cdecl;
-
-  aspell_string_list_size: function(ths:PAspellStringList):cuint;cdecl;
-
-  aspell_string_list_elements: function(ths:PAspellStringList):PAspellStringEnumeration;cdecl;
-
-  aspell_string_list_add: function(ths:PAspellStringList; to_add:pchar):cint;cdecl;
-
-  aspell_string_list_remove: function(ths:PAspellStringList; to_rem:pchar):cint;cdecl;
-
-  aspell_string_list_clear: procedure(ths:PAspellStringList);cdecl;
-
-  aspell_string_list_to_mutable_container: function(ths:PAspellStringList):PAspellMutableContainer;cdecl;
-
-  delete_aspell_string_list: procedure(ths:PAspellStringList);cdecl;
-
-  aspell_string_list_clone: function(ths:PAspellStringList):PAspellStringList;cdecl;
-
-  aspell_string_list_assign: procedure(ths:PAspellStringList; other:PAspellStringList);cdecl;
-
-      {***************************** string map ***************************** }
-
-  new_aspell_string_map: function():PAspellStringMap;cdecl;
-
-  aspell_string_map_add: function(ths:PAspellStringMap; to_add:pchar):cint;cdecl;
-
-  aspell_string_map_remove: function(ths:PAspellStringMap; to_rem:pchar):cint;cdecl;
-
-  aspell_string_map_clear: procedure(ths:PAspellStringMap);cdecl;
-
-  aspell_string_map_to_mutable_container: function(ths:PAspellStringMap):PAspellMutableContainer;cdecl;
-
-  delete_aspell_string_map: procedure(ths:PAspellStringMap);cdecl;
-
-  aspell_string_map_clone: function(ths:PAspellStringMap):PAspellStringMap;cdecl;
-
-  aspell_string_map_assign: procedure(ths:PAspellStringMap; other:PAspellStringMap);cdecl;
-
-  aspell_string_map_empty: function(ths:PAspellStringMap):cint;cdecl;
-
-  aspell_string_map_size: function(ths:PAspellStringMap):cuint;cdecl;
-
-  aspell_string_map_elements: function(ths:PAspellStringMap):PAspellStringPairEnumeration;cdecl;
-
-      { Insert a new element.
-       * Will NOT overwrite an existing entry.
-       * Returns FALSE if the element already exists.  }
-
-  aspell_string_map_insert: function(ths:PAspellStringMap; key:pchar; value:pchar):cint;cdecl;
-
-      { Insert a new element.
-       * Will overwrite an existing entry.
-       * Always returns TRUE.  }
-
-  aspell_string_map_replace: function(ths:PAspellStringMap; key:pchar; value:pchar):cint;cdecl;
-
-      { Looks up an element and returns the value.
-       * Returns NULL if the element does not exist.
-       * Returns an empty string if the element exists
-       * but has a NULL value.  }
-
-  aspell_string_map_lookup: function(ths:PAspellStringMap; key:pchar):pchar;cdecl;
-
-      {********************** string pair enumeration ********************** }
-
-  aspell_string_pair_enumeration_at_end: function(ths:PAspellStringPairEnumeration):cint;cdecl;
-
-  aspell_string_pair_enumeration_next: function(ths:PAspellStringPairEnumeration):AspellStringPair;cdecl;
-
-  delete_aspell_string_pair_enumeration: procedure(ths:PAspellStringPairEnumeration);cdecl;
-
-  aspell_string_pair_enumeration_clone: function(ths:PAspellStringPairEnumeration):PAspellStringPairEnumeration;cdecl;
-
-  aspell_string_pair_enumeration_assign: procedure(ths:PAspellStringPairEnumeration; other:PAspellStringPairEnumeration);cdecl;
-
-      {******************************* cache ******************************* }
-      { Reset the global cache(s) so that cache queries will
-       * create a new object. If existing objects are still in
-       * use they are not deleted. If which is NULL then all
-       * caches will be reset. Current caches are "encode",
-       * "decode", "dictionary", "language", and "keyboard".  }
-
-  aspell_reset_cache: function(which:pchar):cint;cdecl;
-  
-{$ENDIF}
-
   function aspell_init(const libn: ansistring): Boolean;
   function aspell_loaded: Boolean;
   function aspell_document_checker_next_misspelling(ths:PAspellDocumentChecker):AspellToken;
 
 implementation
 
-{$IFDEF STATIC_ASPELL}
-
 function aspell_init(const libn: ansistring): Boolean;
 begin
   aspell_init := True;
@@ -1003,602 +451,4 @@ begin
   aspell_document_checker_next_misspelling := AspellToken(__aspell_document_checker_next_misspelling(ths));
 end;
 
-{$ELSE} // dynamic
-
-uses
-  {$IFDEF WINDOWS}
-  Windows, SysUtils, Classes,
-  {$ENDIF}
-  dynlibs;
-
-var
-  LibHandle: TLibHandle = 0;
-
-{$IFDEF WINDOWS}
-function RegistryQueryValue (name,sub:shortstring):shortstring;
-const 
-  maxkeysize=255;
-var
-  buf:string [maxkeysize];
-  bufsize:longint;
-  buftype:longint;
-  res:longint;
-  key,rkey:hkey;
-  p,sp:pchar;
-
-begin
-  RegistryQueryValue:='';
-  name:=name+#0; p:=@name[1];
-  if sub='' then sp:=nil else begin sub:=sub+#0; sp:=@sub[1]; end;
-  bufsize:=maxkeysize;
-  buftype:=REG_SZ;
-  key:=HKEY_LOCAL_MACHINE;
-  res:=RegOpenKeyEx (key,p,0,KEY_QUERY_VALUE,rkey);
-  if res<>ERROR_SUCCESS then exit;
-  res:=RegQueryValueEx (rkey,sp,nil,@buftype,@buf[1],@bufsize);
-  if res<>ERROR_SUCCESS then exit;
-  buf[0]:=chr(bufsize-1);
-  RegCloseKey (rkey);
-  RegistryQueryValue:=buf;
-end;
-{$ENDIF}
-
-function aspell_init(const libn: ansistring): Boolean;
-var
-  libname: ansistring;
-  {$IFDEF WINDOWS}
-  bversion, path: ansistring;
-  version: dword;
-  {$ENDIF}
-  {$ifdef linux}
-  i: Integer;
-  s: string;
-  {$endif}
-begin
-  aspell_init := True;
-  libname := libn;
-  
-  {$IFDEF windows}
-  bversion := RegistryQueryValue('SOFTWARE\Aspell','AspellVersion');
-  if Length(bversion) >= 4 then begin
-    move(bversion[1], version, 4);
-    path := RegistryQueryValue('SOFTWARE\Aspell','Path');
-    // will work if they passed %s, won't bork if they passed absolute
-    libname := path + PathDelim + StringReplace(libn, '%s', IntToStr(Version), [rfReplaceAll]);
-  end;
-  {$ENDIF}
-
-  LibHandle := LoadLibrary(libname);
-  {$ifdef darwin}
-  if LibHandle = 0 then begin
-    libname := '/sw/lib/libaspell.dylib';
-    LibHandle := LoadLibrary(libname);
-  end;
-  {$endif}
-
-  {$ifdef linux}
-  if LibHandle = 0 then begin
-    for i := 15 to 30 do begin // TODO: make sure to up this when required
-      str(i, s);
-      libname := libn + '.' + s;
-      LibHandle := LoadLibrary(libname);
-      if LibHandle <> 0 then
-        Break;
-    end;
-  end;
-  {$endif}
-
-  if LibHandle = 0 then
-    Exit(False);
-
-  aspell_mutable_container_add := nil;
-  Pointer(aspell_mutable_container_add) := GetProcedureAddress(LibHandle, 'aspell_mutable_container_add');
-  if not Assigned(aspell_mutable_container_add) then Exit(False);
-
-  aspell_mutable_container_remove := nil;
-  Pointer(aspell_mutable_container_remove) := GetProcedureAddress(LibHandle, 'aspell_mutable_container_remove');
-  if not Assigned(aspell_mutable_container_remove) then Exit(False);
-
-  aspell_mutable_container_clear := nil;
-  Pointer(aspell_mutable_container_clear) := GetProcedureAddress(LibHandle, 'aspell_mutable_container_clear');
-  if not Assigned(aspell_mutable_container_clear) then Exit(False);
-
-  aspell_mutable_container_to_mutable_container := nil;
-  Pointer(aspell_mutable_container_to_mutable_container) := GetProcedureAddress(LibHandle, 'aspell_mutable_container_to_mutable_container');
-  if not Assigned(aspell_mutable_container_to_mutable_container) then Exit(False);
-
-  aspell_key_info_enumeration_at_end := nil;
-  Pointer(aspell_key_info_enumeration_at_end) := GetProcedureAddress(LibHandle, 'aspell_key_info_enumeration_at_end');
-  if not Assigned(aspell_key_info_enumeration_at_end) then Exit(False);
-
-  aspell_key_info_enumeration_next := nil;
-  Pointer(aspell_key_info_enumeration_next) := GetProcedureAddress(LibHandle, 'aspell_key_info_enumeration_next');
-  if not Assigned(aspell_key_info_enumeration_next) then Exit(False);
-
-  delete_aspell_key_info_enumeration := nil;
-  Pointer(delete_aspell_key_info_enumeration) := GetProcedureAddress(LibHandle, 'delete_aspell_key_info_enumeration');
-  if not Assigned(delete_aspell_key_info_enumeration) then Exit(False);
-
-  aspell_key_info_enumeration_clone := nil;
-  Pointer(aspell_key_info_enumeration_clone) := GetProcedureAddress(LibHandle, 'aspell_key_info_enumeration_clone');
-  if not Assigned(aspell_key_info_enumeration_clone) then Exit(False);
-
-  aspell_key_info_enumeration_assign := nil;
-  Pointer(aspell_key_info_enumeration_assign) := GetProcedureAddress(LibHandle, 'aspell_key_info_enumeration_assign');
-  if not Assigned(aspell_key_info_enumeration_assign) then Exit(False);
-
-  new_aspell_config := nil;
-  Pointer(new_aspell_config) := GetProcedureAddress(LibHandle, 'new_aspell_config');
-  if not Assigned(new_aspell_config) then Exit(False);
-
-  delete_aspell_config := nil;
-  Pointer(delete_aspell_config) := GetProcedureAddress(LibHandle, 'delete_aspell_config');
-  if not Assigned(delete_aspell_config) then Exit(False);
-
-  aspell_config_clone := nil;
-  Pointer(aspell_config_clone) := GetProcedureAddress(LibHandle, 'aspell_config_clone');
-  if not Assigned(aspell_config_clone) then Exit(False);
-
-  aspell_config_assign := nil;
-  Pointer(aspell_config_assign) := GetProcedureAddress(LibHandle, 'aspell_config_assign');
-  if not Assigned(aspell_config_assign) then Exit(False);
-
-  aspell_config_error_number := nil;
-  Pointer(aspell_config_error_number) := GetProcedureAddress(LibHandle, 'aspell_config_error_number');
-  if not Assigned(aspell_config_error_number) then Exit(False);
-
-  aspell_config_error_message := nil;
-  Pointer(aspell_config_error_message) := GetProcedureAddress(LibHandle, 'aspell_config_error_message');
-  if not Assigned(aspell_config_error_message) then Exit(False);
-
-  aspell_config_error := nil;
-  Pointer(aspell_config_error) := GetProcedureAddress(LibHandle, 'aspell_config_error');
-  if not Assigned(aspell_config_error) then Exit(False);
-
-  aspell_config_set_extra := nil;
-  Pointer(aspell_config_set_extra) := GetProcedureAddress(LibHandle, 'aspell_config_set_extra');
-  if not Assigned(aspell_config_set_extra) then Exit(False);
-
-  aspell_config_keyinfo := nil;
-  Pointer(aspell_config_keyinfo) := GetProcedureAddress(LibHandle, 'aspell_config_keyinfo');
-  if not Assigned(aspell_config_keyinfo) then Exit(False);
-
-  aspell_config_possible_elements := nil;
-  Pointer(aspell_config_possible_elements) := GetProcedureAddress(LibHandle, 'aspell_config_possible_elements');
-  if not Assigned(aspell_config_possible_elements) then Exit(False);
-
-  aspell_config_get_default := nil;
-  Pointer(aspell_config_get_default) := GetProcedureAddress(LibHandle, 'aspell_config_get_default');
-  if not Assigned(aspell_config_get_default) then Exit(False);
-
-  aspell_config_elements := nil;
-  Pointer(aspell_config_elements) := GetProcedureAddress(LibHandle, 'aspell_config_elements');
-  if not Assigned(aspell_config_elements) then Exit(False);
-
-  aspell_config_replace := nil;
-  Pointer(aspell_config_replace) := GetProcedureAddress(LibHandle, 'aspell_config_replace');
-  if not Assigned(aspell_config_replace) then Exit(False);
-
-  aspell_config_remove := nil;
-  Pointer(aspell_config_remove) := GetProcedureAddress(LibHandle, 'aspell_config_remove');
-  if not Assigned(aspell_config_remove) then Exit(False);
-
-  aspell_config_have := nil;
-  Pointer(aspell_config_have) := GetProcedureAddress(LibHandle, 'aspell_config_have');
-  if not Assigned(aspell_config_have) then Exit(False);
-
-  aspell_config_retrieve := nil;
-  Pointer(aspell_config_retrieve) := GetProcedureAddress(LibHandle, 'aspell_config_retrieve');
-  if not Assigned(aspell_config_retrieve) then Exit(False);
-
-  aspell_config_retrieve_list := nil;
-  Pointer(aspell_config_retrieve_list) := GetProcedureAddress(LibHandle, 'aspell_config_retrieve_list');
-  if not Assigned(aspell_config_retrieve_list) then Exit(False);
-
-  aspell_config_retrieve_bool := nil;
-  Pointer(aspell_config_retrieve_bool) := GetProcedureAddress(LibHandle, 'aspell_config_retrieve_bool');
-  if not Assigned(aspell_config_retrieve_bool) then Exit(False);
-
-  aspell_config_retrieve_int := nil;
-  Pointer(aspell_config_retrieve_int) := GetProcedureAddress(LibHandle, 'aspell_config_retrieve_int');
-  if not Assigned(aspell_config_retrieve_int) then Exit(False);
-
-  aspell_error_is_a := nil;
-  Pointer(aspell_error_is_a) := GetProcedureAddress(LibHandle, 'aspell_error_is_a');
-  if not Assigned(aspell_error_is_a) then Exit(False);
-
-  aspell_error_number := nil;
-  Pointer(aspell_error_number) := GetProcedureAddress(LibHandle, 'aspell_error_number');
-  if not Assigned(aspell_error_number) then Exit(False);
-
-  aspell_error_message := nil;
-  Pointer(aspell_error_message) := GetProcedureAddress(LibHandle, 'aspell_error_message');
-  if not Assigned(aspell_error_message) then Exit(False);
-
-  aspell_error := nil;
-  Pointer(aspell_error) := GetProcedureAddress(LibHandle, 'aspell_error');
-  if not Assigned(aspell_error) then Exit(False);
-
-  delete_aspell_can_have_error := nil;
-  Pointer(delete_aspell_can_have_error) := GetProcedureAddress(LibHandle, 'delete_aspell_can_have_error');
-  if not Assigned(delete_aspell_can_have_error) then Exit(False);
-
-  new_aspell_speller := nil;
-  Pointer(new_aspell_speller) := GetProcedureAddress(LibHandle, 'new_aspell_speller');
-  if not Assigned(new_aspell_speller) then Exit(False);
-
-  to_aspell_speller := nil;
-  Pointer(to_aspell_speller) := GetProcedureAddress(LibHandle, 'to_aspell_speller');
-  if not Assigned(to_aspell_speller) then Exit(False);
-
-  delete_aspell_speller := nil;
-  Pointer(delete_aspell_speller) := GetProcedureAddress(LibHandle, 'delete_aspell_speller');
-  if not Assigned(delete_aspell_speller) then Exit(False);
-
-  aspell_speller_error_number := nil;
-  Pointer(aspell_speller_error_number) := GetProcedureAddress(LibHandle, 'aspell_speller_error_number');
-  if not Assigned(aspell_speller_error_number) then Exit(False);
-
-  aspell_speller_error_message := nil;
-  Pointer(aspell_speller_error_message) := GetProcedureAddress(LibHandle, 'aspell_speller_error_message');
-  if not Assigned(aspell_speller_error_message) then Exit(False);
-
-  aspell_speller_error := nil;
-  Pointer(aspell_speller_error) := GetProcedureAddress(LibHandle, 'aspell_speller_error');
-  if not Assigned(aspell_speller_error) then Exit(False);
-
-  aspell_speller_config := nil;
-  Pointer(aspell_speller_config) := GetProcedureAddress(LibHandle, 'aspell_speller_config');
-  if not Assigned(aspell_speller_config) then Exit(False);
-
-  aspell_speller_check := nil;
-  Pointer(aspell_speller_check) := GetProcedureAddress(LibHandle, 'aspell_speller_check');
-  if not Assigned(aspell_speller_check) then Exit(False);
-
-  aspell_speller_add_to_personal := nil;
-  Pointer(aspell_speller_add_to_personal) := GetProcedureAddress(LibHandle, 'aspell_speller_add_to_personal');
-  if not Assigned(aspell_speller_add_to_personal) then Exit(False);
-
-  aspell_speller_add_to_session := nil;
-  Pointer(aspell_speller_add_to_session) := GetProcedureAddress(LibHandle, 'aspell_speller_add_to_session');
-  if not Assigned(aspell_speller_add_to_session) then Exit(False);
-
-  aspell_speller_personal_word_list := nil;
-  Pointer(aspell_speller_personal_word_list) := GetProcedureAddress(LibHandle, 'aspell_speller_personal_word_list');
-  if not Assigned(aspell_speller_personal_word_list) then Exit(False);
-
-  aspell_speller_session_word_list := nil;
-  Pointer(aspell_speller_session_word_list) := GetProcedureAddress(LibHandle, 'aspell_speller_session_word_list');
-  if not Assigned(aspell_speller_session_word_list) then Exit(False);
-
-  aspell_speller_main_word_list := nil;
-  Pointer(aspell_speller_main_word_list) := GetProcedureAddress(LibHandle, 'aspell_speller_main_word_list');
-  if not Assigned(aspell_speller_main_word_list) then Exit(False);
-
-  aspell_speller_save_all_word_lists := nil;
-  Pointer(aspell_speller_save_all_word_lists) := GetProcedureAddress(LibHandle, 'aspell_speller_save_all_word_lists');
-  if not Assigned(aspell_speller_save_all_word_lists) then Exit(False);
-
-  aspell_speller_clear_session := nil;
-  Pointer(aspell_speller_clear_session) := GetProcedureAddress(LibHandle, 'aspell_speller_clear_session');
-  if not Assigned(aspell_speller_clear_session) then Exit(False);
-
-  aspell_speller_suggest := nil;
-  Pointer(aspell_speller_suggest) := GetProcedureAddress(LibHandle, 'aspell_speller_suggest');
-  if not Assigned(aspell_speller_suggest) then Exit(False);
-
-  aspell_speller_store_replacement := nil;
-  Pointer(aspell_speller_store_replacement) := GetProcedureAddress(LibHandle, 'aspell_speller_store_replacement');
-  if not Assigned(aspell_speller_store_replacement) then Exit(False);
-
-  delete_aspell_filter := nil;
-  Pointer(delete_aspell_filter) := GetProcedureAddress(LibHandle, 'delete_aspell_filter');
-  if not Assigned(delete_aspell_filter) then Exit(False);
-
-  aspell_filter_error_number := nil;
-  Pointer(aspell_filter_error_number) := GetProcedureAddress(LibHandle, 'aspell_filter_error_number');
-  if not Assigned(aspell_filter_error_number) then Exit(False);
-
-  aspell_filter_error_message := nil;
-  Pointer(aspell_filter_error_message) := GetProcedureAddress(LibHandle, 'aspell_filter_error_message');
-  if not Assigned(aspell_filter_error_message) then Exit(False);
-
-  aspell_filter_error := nil;
-  Pointer(aspell_filter_error) := GetProcedureAddress(LibHandle, 'aspell_filter_error');
-  if not Assigned(aspell_filter_error) then Exit(False);
-
-  to_aspell_filter := nil;
-  Pointer(to_aspell_filter) := GetProcedureAddress(LibHandle, 'to_aspell_filter');
-  if not Assigned(to_aspell_filter) then Exit(False);
-
-  delete_aspell_document_checker := nil;
-  Pointer(delete_aspell_document_checker) := GetProcedureAddress(LibHandle, 'delete_aspell_document_checker');
-  if not Assigned(delete_aspell_document_checker) then Exit(False);
-
-  aspell_document_checker_error_number := nil;
-  Pointer(aspell_document_checker_error_number) := GetProcedureAddress(LibHandle, 'aspell_document_checker_error_number');
-  if not Assigned(aspell_document_checker_error_number) then Exit(False);
-
-  aspell_document_checker_error_message := nil;
-  Pointer(aspell_document_checker_error_message) := GetProcedureAddress(LibHandle, 'aspell_document_checker_error_message');
-  if not Assigned(aspell_document_checker_error_message) then Exit(False);
-
-  aspell_document_checker_error := nil;
-  Pointer(aspell_document_checker_error) := GetProcedureAddress(LibHandle, 'aspell_document_checker_error');
-  if not Assigned(aspell_document_checker_error) then Exit(False);
-
-  new_aspell_document_checker := nil;
-  Pointer(new_aspell_document_checker) := GetProcedureAddress(LibHandle, 'new_aspell_document_checker');
-  if not Assigned(new_aspell_document_checker) then Exit(False);
-
-  to_aspell_document_checker := nil;
-  Pointer(to_aspell_document_checker) := GetProcedureAddress(LibHandle, 'to_aspell_document_checker');
-  if not Assigned(to_aspell_document_checker) then Exit(False);
-
-  aspell_document_checker_reset := nil;
-  Pointer(aspell_document_checker_reset) := GetProcedureAddress(LibHandle, 'aspell_document_checker_reset');
-  if not Assigned(aspell_document_checker_reset) then Exit(False);
-
-  aspell_document_checker_process := nil;
-  Pointer(aspell_document_checker_process) := GetProcedureAddress(LibHandle, 'aspell_document_checker_process');
-  if not Assigned(aspell_document_checker_process) then Exit(False);
-
-  __aspell_document_checker_next_misspelling := nil;
-  Pointer(__aspell_document_checker_next_misspelling) := GetProcedureAddress(LibHandle, 'aspell_document_checker_next_misspelling');
-  if not Assigned(__aspell_document_checker_next_misspelling) then Exit(False);
-
-  aspell_document_checker_filter := nil;
-  Pointer(aspell_document_checker_filter) := GetProcedureAddress(LibHandle, 'aspell_document_checker_filter');
-  if not Assigned(aspell_document_checker_filter) then Exit(False);
-
-  aspell_word_list_empty := nil;
-  Pointer(aspell_word_list_empty) := GetProcedureAddress(LibHandle, 'aspell_word_list_empty');
-  if not Assigned(aspell_word_list_empty) then Exit(False);
-
-  aspell_word_list_size := nil;
-  Pointer(aspell_word_list_size) := GetProcedureAddress(LibHandle, 'aspell_word_list_size');
-  if not Assigned(aspell_word_list_size) then Exit(False);
-
-  aspell_word_list_elements := nil;
-  Pointer(aspell_word_list_elements) := GetProcedureAddress(LibHandle, 'aspell_word_list_elements');
-  if not Assigned(aspell_word_list_elements) then Exit(False);
-
-  delete_aspell_string_enumeration := nil;
-  Pointer(delete_aspell_string_enumeration) := GetProcedureAddress(LibHandle, 'delete_aspell_string_enumeration');
-  if not Assigned(delete_aspell_string_enumeration) then Exit(False);
-
-  aspell_string_enumeration_clone := nil;
-  Pointer(aspell_string_enumeration_clone) := GetProcedureAddress(LibHandle, 'aspell_string_enumeration_clone');
-  if not Assigned(aspell_string_enumeration_clone) then Exit(False);
-
-  aspell_string_enumeration_assign := nil;
-  Pointer(aspell_string_enumeration_assign) := GetProcedureAddress(LibHandle, 'aspell_string_enumeration_assign');
-  if not Assigned(aspell_string_enumeration_assign) then Exit(False);
-
-  aspell_string_enumeration_at_end := nil;
-  Pointer(aspell_string_enumeration_at_end) := GetProcedureAddress(LibHandle, 'aspell_string_enumeration_at_end');
-  if not Assigned(aspell_string_enumeration_at_end) then Exit(False);
-
-  aspell_string_enumeration_next := nil;
-  Pointer(aspell_string_enumeration_next) := GetProcedureAddress(LibHandle, 'aspell_string_enumeration_next');
-  if not Assigned(aspell_string_enumeration_next) then Exit(False);
-
-  get_aspell_module_info_list := nil;
-  Pointer(get_aspell_module_info_list) := GetProcedureAddress(LibHandle, 'get_aspell_module_info_list');
-  if not Assigned(get_aspell_module_info_list) then Exit(False);
-
-  aspell_module_info_list_empty := nil;
-  Pointer(aspell_module_info_list_empty) := GetProcedureAddress(LibHandle, 'aspell_module_info_list_empty');
-  if not Assigned(aspell_module_info_list_empty) then Exit(False);
-
-  aspell_module_info_list_size := nil;
-  Pointer(aspell_module_info_list_size) := GetProcedureAddress(LibHandle, 'aspell_module_info_list_size');
-  if not Assigned(aspell_module_info_list_size) then Exit(False);
-
-  aspell_module_info_list_elements := nil;
-  Pointer(aspell_module_info_list_elements) := GetProcedureAddress(LibHandle, 'aspell_module_info_list_elements');
-  if not Assigned(aspell_module_info_list_elements) then Exit(False);
-
-  get_aspell_dict_info_list := nil;
-  Pointer(get_aspell_dict_info_list) := GetProcedureAddress(LibHandle, 'get_aspell_dict_info_list');
-  if not Assigned(get_aspell_dict_info_list) then Exit(False);
-
-  aspell_dict_info_list_empty := nil;
-  Pointer(aspell_dict_info_list_empty) := GetProcedureAddress(LibHandle, 'aspell_dict_info_list_empty');
-  if not Assigned(aspell_dict_info_list_empty) then Exit(False);
-
-  aspell_dict_info_list_size := nil;
-  Pointer(aspell_dict_info_list_size) := GetProcedureAddress(LibHandle, 'aspell_dict_info_list_size');
-  if not Assigned(aspell_dict_info_list_size) then Exit(False);
-
-  aspell_dict_info_list_elements := nil;
-  Pointer(aspell_dict_info_list_elements) := GetProcedureAddress(LibHandle, 'aspell_dict_info_list_elements');
-  if not Assigned(aspell_dict_info_list_elements) then Exit(False);
-
-  aspell_module_info_enumeration_at_end := nil;
-  Pointer(aspell_module_info_enumeration_at_end) := GetProcedureAddress(LibHandle, 'aspell_module_info_enumeration_at_end');
-  if not Assigned(aspell_module_info_enumeration_at_end) then Exit(False);
-
-  aspell_module_info_enumeration_next := nil;
-  Pointer(aspell_module_info_enumeration_next) := GetProcedureAddress(LibHandle, 'aspell_module_info_enumeration_next');
-  if not Assigned(aspell_module_info_enumeration_next) then Exit(False);
-
-  delete_aspell_module_info_enumeration := nil;
-  Pointer(delete_aspell_module_info_enumeration) := GetProcedureAddress(LibHandle, 'delete_aspell_module_info_enumeration');
-  if not Assigned(delete_aspell_module_info_enumeration) then Exit(False);
-
-  aspell_module_info_enumeration_clone := nil;
-  Pointer(aspell_module_info_enumeration_clone) := GetProcedureAddress(LibHandle, 'aspell_module_info_enumeration_clone');
-  if not Assigned(aspell_module_info_enumeration_clone) then Exit(False);
-
-  aspell_module_info_enumeration_assign := nil;
-  Pointer(aspell_module_info_enumeration_assign) := GetProcedureAddress(LibHandle, 'aspell_module_info_enumeration_assign');
-  if not Assigned(aspell_module_info_enumeration_assign) then Exit(False);
-
-  aspell_dict_info_enumeration_at_end := nil;
-  Pointer(aspell_dict_info_enumeration_at_end) := GetProcedureAddress(LibHandle, 'aspell_dict_info_enumeration_at_end');
-  if not Assigned(aspell_dict_info_enumeration_at_end) then Exit(False);
-
-  aspell_dict_info_enumeration_next := nil;
-  Pointer(aspell_dict_info_enumeration_next) := GetProcedureAddress(LibHandle, 'aspell_dict_info_enumeration_next');
-  if not Assigned(aspell_dict_info_enumeration_next) then Exit(False);
-
-  delete_aspell_dict_info_enumeration := nil;
-  Pointer(delete_aspell_dict_info_enumeration) := GetProcedureAddress(LibHandle, 'delete_aspell_dict_info_enumeration');
-  if not Assigned(delete_aspell_dict_info_enumeration) then Exit(False);
-
-  aspell_dict_info_enumeration_clone := nil;
-  Pointer(aspell_dict_info_enumeration_clone) := GetProcedureAddress(LibHandle, 'aspell_dict_info_enumeration_clone');
-  if not Assigned(aspell_dict_info_enumeration_clone) then Exit(False);
-
-  aspell_dict_info_enumeration_assign := nil;
-  Pointer(aspell_dict_info_enumeration_assign) := GetProcedureAddress(LibHandle, 'aspell_dict_info_enumeration_assign');
-  if not Assigned(aspell_dict_info_enumeration_assign) then Exit(False);
-
-  new_aspell_string_list := nil;
-  Pointer(new_aspell_string_list) := GetProcedureAddress(LibHandle, 'new_aspell_string_list');
-  if not Assigned(new_aspell_string_list) then Exit(False);
-
-  aspell_string_list_empty := nil;
-  Pointer(aspell_string_list_empty) := GetProcedureAddress(LibHandle, 'aspell_string_list_empty');
-  if not Assigned(aspell_string_list_empty) then Exit(False);
-
-  aspell_string_list_size := nil;
-  Pointer(aspell_string_list_size) := GetProcedureAddress(LibHandle, 'aspell_string_list_size');
-  if not Assigned(aspell_string_list_size) then Exit(False);
-
-  aspell_string_list_elements := nil;
-  Pointer(aspell_string_list_elements) := GetProcedureAddress(LibHandle, 'aspell_string_list_elements');
-  if not Assigned(aspell_string_list_elements) then Exit(False);
-
-  aspell_string_list_add := nil;
-  Pointer(aspell_string_list_add) := GetProcedureAddress(LibHandle, 'aspell_string_list_add');
-  if not Assigned(aspell_string_list_add) then Exit(False);
-
-  aspell_string_list_remove := nil;
-  Pointer(aspell_string_list_remove) := GetProcedureAddress(LibHandle, 'aspell_string_list_remove');
-  if not Assigned(aspell_string_list_remove) then Exit(False);
-
-  aspell_string_list_clear := nil;
-  Pointer(aspell_string_list_clear) := GetProcedureAddress(LibHandle, 'aspell_string_list_clear');
-  if not Assigned(aspell_string_list_clear) then Exit(False);
-
-  aspell_string_list_to_mutable_container := nil;
-  Pointer(aspell_string_list_to_mutable_container) := GetProcedureAddress(LibHandle, 'aspell_string_list_to_mutable_container');
-  if not Assigned(aspell_string_list_to_mutable_container) then Exit(False);
-
-  delete_aspell_string_list := nil;
-  Pointer(delete_aspell_string_list) := GetProcedureAddress(LibHandle, 'delete_aspell_string_list');
-  if not Assigned(delete_aspell_string_list) then Exit(False);
-
-  aspell_string_list_clone := nil;
-  Pointer(aspell_string_list_clone) := GetProcedureAddress(LibHandle, 'aspell_string_list_clone');
-  if not Assigned(aspell_string_list_clone) then Exit(False);
-
-  aspell_string_list_assign := nil;
-  Pointer(aspell_string_list_assign) := GetProcedureAddress(LibHandle, 'aspell_string_list_assign');
-  if not Assigned(aspell_string_list_assign) then Exit(False);
-
-  new_aspell_string_map := nil;
-  Pointer(new_aspell_string_map) := GetProcedureAddress(LibHandle, 'new_aspell_string_map');
-  if not Assigned(new_aspell_string_map) then Exit(False);
-
-  aspell_string_map_add := nil;
-  Pointer(aspell_string_map_add) := GetProcedureAddress(LibHandle, 'aspell_string_map_add');
-  if not Assigned(aspell_string_map_add) then Exit(False);
-
-  aspell_string_map_remove := nil;
-  Pointer(aspell_string_map_remove) := GetProcedureAddress(LibHandle, 'aspell_string_map_remove');
-  if not Assigned(aspell_string_map_remove) then Exit(False);
-
-  aspell_string_map_clear := nil;
-  Pointer(aspell_string_map_clear) := GetProcedureAddress(LibHandle, 'aspell_string_map_clear');
-  if not Assigned(aspell_string_map_clear) then Exit(False);
-
-  aspell_string_map_to_mutable_container := nil;
-  Pointer(aspell_string_map_to_mutable_container) := GetProcedureAddress(LibHandle, 'aspell_string_map_to_mutable_container');
-  if not Assigned(aspell_string_map_to_mutable_container) then Exit(False);
-
-  delete_aspell_string_map := nil;
-  Pointer(delete_aspell_string_map) := GetProcedureAddress(LibHandle, 'delete_aspell_string_map');
-  if not Assigned(delete_aspell_string_map) then Exit(False);
-
-  aspell_string_map_clone := nil;
-  Pointer(aspell_string_map_clone) := GetProcedureAddress(LibHandle, 'aspell_string_map_clone');
-  if not Assigned(aspell_string_map_clone) then Exit(False);
-
-  aspell_string_map_assign := nil;
-  Pointer(aspell_string_map_assign) := GetProcedureAddress(LibHandle, 'aspell_string_map_assign');
-  if not Assigned(aspell_string_map_assign) then Exit(False);
-
-  aspell_string_map_empty := nil;
-  Pointer(aspell_string_map_empty) := GetProcedureAddress(LibHandle, 'aspell_string_map_empty');
-  if not Assigned(aspell_string_map_empty) then Exit(False);
-
-  aspell_string_map_size := nil;
-  Pointer(aspell_string_map_size) := GetProcedureAddress(LibHandle, 'aspell_string_map_size');
-  if not Assigned(aspell_string_map_size) then Exit(False);
-
-  aspell_string_map_elements := nil;
-  Pointer(aspell_string_map_elements) := GetProcedureAddress(LibHandle, 'aspell_string_map_elements');
-  if not Assigned(aspell_string_map_elements) then Exit(False);
-
-  aspell_string_map_insert := nil;
-  Pointer(aspell_string_map_insert) := GetProcedureAddress(LibHandle, 'aspell_string_map_insert');
-  if not Assigned(aspell_string_map_insert) then Exit(False);
-
-  aspell_string_map_replace := nil;
-  Pointer(aspell_string_map_replace) := GetProcedureAddress(LibHandle, 'aspell_string_map_replace');
-  if not Assigned(aspell_string_map_replace) then Exit(False);
-
-  aspell_string_map_lookup := nil;
-  Pointer(aspell_string_map_lookup) := GetProcedureAddress(LibHandle, 'aspell_string_map_lookup');
-  if not Assigned(aspell_string_map_lookup) then Exit(False);
-
-  aspell_string_pair_enumeration_at_end := nil;
-  Pointer(aspell_string_pair_enumeration_at_end) := GetProcedureAddress(LibHandle, 'aspell_string_pair_enumeration_at_end');
-  if not Assigned(aspell_string_pair_enumeration_at_end) then Exit(False);
-
-  aspell_string_pair_enumeration_next := nil;
-  Pointer(aspell_string_pair_enumeration_next) := GetProcedureAddress(LibHandle, 'aspell_string_pair_enumeration_next');
-  if not Assigned(aspell_string_pair_enumeration_next) then Exit(False);
-
-  delete_aspell_string_pair_enumeration := nil;
-  Pointer(delete_aspell_string_pair_enumeration) := GetProcedureAddress(LibHandle, 'delete_aspell_string_pair_enumeration');
-  if not Assigned(delete_aspell_string_pair_enumeration) then Exit(False);
-
-  aspell_string_pair_enumeration_clone := nil;
-  Pointer(aspell_string_pair_enumeration_clone) := GetProcedureAddress(LibHandle, 'aspell_string_pair_enumeration_clone');
-  if not Assigned(aspell_string_pair_enumeration_clone) then Exit(False);
-
-  aspell_string_pair_enumeration_assign := nil;
-  Pointer(aspell_string_pair_enumeration_assign) := GetProcedureAddress(LibHandle, 'aspell_string_pair_enumeration_assign');
-  if not Assigned(aspell_string_pair_enumeration_assign) then Exit(False);
-
-  aspell_reset_cache := nil;
-  Pointer(aspell_reset_cache) := GetProcedureAddress(LibHandle, 'aspell_reset_cache');
-  if not Assigned(aspell_reset_cache) then Exit(False);
-end;
-
-function aspell_loaded: Boolean;
-begin
-  aspell_loaded := LibHandle <> 0;
-end;
-
-function aspell_document_checker_next_misspelling(ths: PAspellDocumentChecker
-  ): AspellToken;
-begin
-  // yup...
-  aspell_document_checker_next_misspelling := AspellToken(__aspell_document_checker_next_misspelling(ths));
-end;
-
-initialization
-  aspell_init(libaspell);
-
-finalization
-  if LibHandle <> 0 then
-    UnloadLibrary(LibHandle);
-    
-{$ENDIF}
-
 end.

packages/aspell/src/aspelldyn.pp

@@ -0,0 +1,1036 @@
+unit aspelldyn;
+
+{ * This file is header translation of The New Aspell
+  * Copyright (C) 2001-2002 by Kevin Atkinson under the GNU LGPL
+  * license version 2.0 or 2.1.  You should have received a copy of the
+  * LGPL license along with this library if you did not you can find it
+  * at http://www.gnu.org/.                                              * }
+
+{ * Translation to pascal (c) 2008 by Aleš Katona. * }
+
+{$PACKRECORDS C}
+
+interface
+
+uses
+  cTypes;
+
+{$IFDEF UNIX}
+  // TODO: check if it works pathless in beosOB
+  {$ifndef DARWIN}
+  const libaspell = 'libaspell.so';
+  {$ELSE}
+  {WARNING Is it possible to omit the path?}
+  const libaspell = 'libaspell.dylib';
+  {$ENDIF}
+{$ELSE} // windows
+  const libaspell = 'aspell-%s.dll';
+{$ENDIF}
+
+  {$i aspelltypes.inc}
+
+  {************************* mutable container ************************* }
+var
+  aspell_mutable_container_add: function(ths:PAspellMutableContainer; to_add:pchar):cint;cdecl;
+
+  aspell_mutable_container_remove: function(ths:PAspellMutableContainer; to_rem:pchar):cint;cdecl;
+
+  aspell_mutable_container_clear: procedure(ths:PAspellMutableContainer);cdecl;
+
+  aspell_mutable_container_to_mutable_container: function(ths:PAspellMutableContainer):PAspellMutableContainer;cdecl;
+
+      {******************************* config ******************************* }
+
+  aspell_key_info_enumeration_at_end: function(ths:PAspellKeyInfoEnumeration):cint;cdecl;
+
+  aspell_key_info_enumeration_next: function(ths:PAspellKeyInfoEnumeration):PAspellKeyInfo;cdecl;
+
+  delete_aspell_key_info_enumeration: procedure(ths:PAspellKeyInfoEnumeration);cdecl;
+
+  aspell_key_info_enumeration_clone: function(ths:PAspellKeyInfoEnumeration):PAspellKeyInfoEnumeration;cdecl;
+
+  aspell_key_info_enumeration_assign: procedure(ths:PAspellKeyInfoEnumeration; other:PAspellKeyInfoEnumeration);cdecl;
+
+  new_aspell_config: function():PAspellConfig;cdecl;
+
+  delete_aspell_config: procedure(ths:PAspellConfig);cdecl;
+
+  aspell_config_clone: function(ths:PAspellConfig):PAspellConfig;cdecl;
+
+  aspell_config_assign: procedure(ths:PAspellConfig; other:PAspellConfig);cdecl;
+
+  aspell_config_error_number: function(ths:PAspellConfig):cuint;cdecl;
+
+  aspell_config_error_message: function(ths:PAspellConfig):pchar;cdecl;
+
+  aspell_config_error: function(ths:PAspellConfig):PAspellError;cdecl;
+
+      { Sets extra keys which this config class should
+       * accept. begin and end are expected to point to
+       * the beginning and ending of an array of Aspell
+       * Key Info.  }
+
+  aspell_config_set_extra: procedure(ths:PAspellConfig; b:PAspellKeyInfo; e:PAspellKeyInfo);cdecl;
+
+      { Returns the KeyInfo object for the
+       * corresponding key or returns NULL and sets
+       * error_num to PERROR_UNKNOWN_KEY if the key is
+       * not valid. The pointer returned is valid for
+       * the lifetime of the object.  }
+
+  aspell_config_keyinfo: function(ths:PAspellConfig; key:pchar):PAspellKeyInfo;cdecl;
+
+      { Returns a newly allocated enumeration of all
+       * the possible objects this config class uses.  }
+
+  aspell_config_possible_elements: function(ths:PAspellConfig; include_extra:cint):PAspellKeyInfoEnumeration;cdecl;
+
+      { Returns the default value for given key which
+       * may involve substituting variables, thus it is
+       * not the same as keyinfo(key)->def returns NULL
+       * and sets error_num to PERROR_UNKNOWN_KEY if
+       * the key is not valid. Uses the temporary
+       * string.  }
+
+  aspell_config_get_default: function(ths:PAspellConfig; key:pchar):pchar;cdecl;
+
+      { Returns a newly allocated enumeration of all
+       * the key/value pairs. This DOES not include ones
+       * which are set to their default values.  }
+
+  aspell_config_elements: function(ths:PAspellConfig):PAspellStringPairEnumeration;cdecl;
+
+      { Inserts an item, if the item already exists it
+       * will be replaced. Returns TRUE if it succeeded
+       * or FALSE on error. If the key is not valid it
+       * sets error_num to PERROR_UNKNOWN_KEY, if the
+       * value is not valid it will set error_num to
+       * PERROR_BAD_VALUE, if the value can not be
+       * changed it sets error_num to
+       * PERROR_CANT_CHANGE_VALUE, and if the value is
+       * a list and you are trying to set its directory,
+       * it sets error_num to PERROR_LIST_SET  }
+
+  aspell_config_replace: function(ths:PAspellConfig; key:pchar; value:pchar):cint;cdecl;
+
+      { Remove a key and returns TRUE if it exists
+       * otherwise return FALSE. This effectively sets
+       * the key to its default value. Calling replace
+       * with a value of "<default>" will also call
+       * remove. If the key does not exist then it sets
+       * error_num to 0 or PERROR_NOT, if the key is
+       * not valid then it sets error_num to
+       * PERROR_UNKNOWN_KEY, if the value can not be
+       * changed then it sets error_num to
+       * PERROR_CANT_CHANGE_VALUE  }
+
+  aspell_config_remove: function(ths:PAspellConfig; key:pchar):cint;cdecl;
+
+  aspell_config_have: function(ths:PAspellConfig; key:pchar):cint;cdecl;
+
+      { Returns NULL on error.  }
+
+  aspell_config_retrieve: function(ths:PAspellConfig; key:pchar):pchar;cdecl;
+
+  aspell_config_retrieve_list: function(ths:PAspellConfig; key:pchar; lst:PAspellMutableContainer):cint;cdecl;
+
+      { In "ths" Aspell configuration, search for a
+       * character string matching "key" string.
+       * If "key" is found then return 1 else return 0.
+       * If error encountered, then return -1.  }
+
+  aspell_config_retrieve_bool: function(ths:PAspellConfig; key:pchar):cint;cdecl;
+
+      { In "ths" Aspell configuration, search for an
+       * integer value matching "key" string.
+       * Return -1 on error.  }
+
+  aspell_config_retrieve_int: function(ths:PAspellConfig; key:pchar):cint;cdecl;
+
+      {******************************* error ******************************* }
+
+  aspell_error_is_a: function(ths:PAspellError; e:PAspellErrorInfo):cint;cdecl;
+
+      {*************************** can have error *************************** }
+
+  aspell_error_number: function(ths:PAspellCanHaveError):cuint;cdecl;
+
+  aspell_error_message: function(ths:PAspellCanHaveError):pchar;cdecl;
+
+  aspell_error: function(ths:PAspellCanHaveError):PAspellError;cdecl;
+
+  delete_aspell_can_have_error: procedure(ths:PAspellCanHaveError);cdecl;
+
+      {******************************* errors ******************************* }
+
+      // ignored
+
+      {****************************** speller ****************************** }
+
+  new_aspell_speller: function(config:PAspellConfig):PAspellCanHaveError;cdecl;
+
+  to_aspell_speller: function(obj:PAspellCanHaveError):PAspellSpeller;cdecl;
+
+  delete_aspell_speller: procedure(ths:PAspellSpeller);cdecl;
+
+  aspell_speller_error_number: function(ths:PAspellSpeller):cuint;cdecl;
+
+  aspell_speller_error_message: function(ths:PAspellSpeller):pchar;cdecl;
+
+  aspell_speller_error: function(ths:PAspellSpeller):PAspellError;cdecl;
+
+  aspell_speller_config: function(ths:PAspellSpeller):PAspellConfig;cdecl;
+      { Returns 0 if it is not in the dictionary,
+       * 1 if it is, or -1 on error.  }
+
+  aspell_speller_check: function(ths:PAspellSpeller; word:pchar; word_size:cint):cint;cdecl;
+
+      { Add this word to your own personal word list.  }
+
+  aspell_speller_add_to_personal: function(ths:PAspellSpeller; word:pchar; word_size:cint):cint;cdecl;
+
+      { Add this word to the current spelling session.  }
+
+  aspell_speller_add_to_session: function(ths:PAspellSpeller; word:pchar; word_size:cint):cint;cdecl;
+
+      { This is your own personal word list file plus
+       * any extra words added during this session to
+       * your own personal word list.  }
+
+  aspell_speller_personal_word_list: function(ths:PAspellSpeller):PAspellWordList;cdecl;
+
+      { This is a list of words added to this session
+       * that are not in the main word list or in your
+       * own personal list but are considered valid for
+       * this spelling session.  }
+
+  aspell_speller_session_word_list: function(ths:PAspellSpeller):PAspellWordList;cdecl;
+
+      { This is the main list of words used during this
+       * spelling session.  }
+
+  aspell_speller_main_word_list: function(ths:PAspellSpeller):PAspellWordList;cdecl;
+
+  aspell_speller_save_all_word_lists: function(ths:PAspellSpeller):cint;cdecl;
+
+  aspell_speller_clear_session: function(ths:PAspellSpeller):cint;cdecl;
+
+      { Return NULL on error.
+       * The word list returned by suggest is only
+       * valid until the next call to suggest.  }
+
+  aspell_speller_suggest: function(ths:PAspellSpeller; word:pchar; word_size:cint):PAspellWordList;cdecl;
+
+  aspell_speller_store_replacement: function(ths:PAspellSpeller; mis:pchar; mis_size:cint; cor:pchar; cor_size:cint):cint;cdecl;
+
+      {******************************* filter ******************************* }
+
+  delete_aspell_filter: procedure(ths:PAspellFilter);cdecl;
+
+  aspell_filter_error_number: function(ths:PAspellFilter):cuint;cdecl;
+
+  aspell_filter_error_message: function(ths:PAspellFilter):pchar;cdecl;
+
+  aspell_filter_error: function(ths:PAspellFilter):PAspellError;cdecl;
+
+  to_aspell_filter: function(obj:PAspellCanHaveError):PAspellFilter;cdecl;
+
+      {************************** document checker ************************** }
+
+  delete_aspell_document_checker: procedure(ths:PAspellDocumentChecker);cdecl;
+
+  aspell_document_checker_error_number: function(ths:PAspellDocumentChecker):cuint;cdecl;
+
+  aspell_document_checker_error_message: function(ths:PAspellDocumentChecker):pchar;cdecl;
+
+  aspell_document_checker_error: function(ths:PAspellDocumentChecker):PAspellError;cdecl;
+
+      { Creates a new document checker.
+       * The speller class is expected to last until
+       * this class is destroyed.
+       * If config is given it will be used to override
+       * any relevent options set by this speller class.
+  is: function done.cdecl;
+       * If filter is given then it will take ownership of
+       * the filter class and use it to do the filtering.
+       * You are expected to free the checker when done.  }
+
+  new_aspell_document_checker: function(speller: PAspellSpeller): PAspellCanHaveError;cdecl;
+
+  to_aspell_document_checker: function(obj:PAspellCanHaveError):PAspellDocumentChecker;cdecl;
+
+      { Reset the internal state of the filter.
+       * Should be called whenever a new document is
+       * being filtered.  }
+  aspell_document_checker_reset: procedure(ths:PAspellDocumentChecker);cdecl;
+
+      { Process a string.
+       * The string passed in should only be split on
+       * white space characters.  Furthermore, between
+       * calls to reset, each string should be passed
+       * in exactly once and in the order they appeared
+       * in the document.  Passing in strings out of
+       * order, skipping strings or passing them in
+       * more than once may lead to undefined results.  }
+
+  aspell_document_checker_process: procedure(ths:PAspellDocumentChecker; str:pchar; size:cint);cdecl;
+
+      { Returns the next misspelled word in the
+       * processed string.  If there are no more
+       * misspelled words, then token.word will be
+       * NULL and token.size will be 0  }
+
+  // hack around struct/cdecl problem
+  __aspell_document_checker_next_misspelling: function(ths:PAspellDocumentChecker):{$IFDEF CPU64}{$IFDEF LINUX}QWord{$ELSE}AspellToken{$ENDIF}{$ELSE}AspellToken{$ENDIF};cdecl;
+
+      { Returns the underlying filter class.  }
+
+  aspell_document_checker_filter: function(ths:PAspellDocumentChecker):PAspellFilter;cdecl;
+
+      {***************************** word list ***************************** }
+
+  aspell_word_list_empty: function(ths:PAspellWordList):cint;cdecl;
+
+  aspell_word_list_size: function(ths:PAspellWordList):cuint;cdecl;
+
+  aspell_word_list_elements: function(ths:PAspellWordList):PAspellStringEnumeration;cdecl;
+
+      {************************* string enumeration ************************* }
+
+  delete_aspell_string_enumeration: procedure(ths:PAspellStringEnumeration);cdecl;
+
+  aspell_string_enumeration_clone: function(ths:PAspellStringEnumeration):PAspellStringEnumeration;cdecl;
+
+  aspell_string_enumeration_assign: procedure(ths:PAspellStringEnumeration; other:PAspellStringEnumeration);cdecl;
+
+  aspell_string_enumeration_at_end: function(ths:PAspellStringEnumeration):cint;cdecl;
+
+  aspell_string_enumeration_next: function(ths:PAspellStringEnumeration):pchar;cdecl;
+
+      {******************************** info ******************************** }
+
+  get_aspell_module_info_list: function(config:PAspellConfig):PAspellModuleInfoList;cdecl;
+
+  aspell_module_info_list_empty: function(ths:PAspellModuleInfoList):cint;cdecl;
+
+  aspell_module_info_list_size: function(ths:PAspellModuleInfoList):cuint;cdecl;
+
+  aspell_module_info_list_elements: function(ths:PAspellModuleInfoList):PAspellModuleInfoEnumeration;cdecl;
+
+  get_aspell_dict_info_list: function(config:PAspellConfig):PAspellDictInfoList;cdecl;
+
+  aspell_dict_info_list_empty: function(ths:PAspellDictInfoList):cint;cdecl;
+
+  aspell_dict_info_list_size: function(ths:PAspellDictInfoList):cuint;cdecl;
+
+  aspell_dict_info_list_elements: function(ths:PAspellDictInfoList):PAspellDictInfoEnumeration;cdecl;
+
+  aspell_module_info_enumeration_at_end: function(ths:PAspellModuleInfoEnumeration):cint;cdecl;
+
+  aspell_module_info_enumeration_next: function(ths:PAspellModuleInfoEnumeration):PAspellModuleInfo;cdecl;
+
+  delete_aspell_module_info_enumeration: procedure(ths:PAspellModuleInfoEnumeration);cdecl;
+
+  aspell_module_info_enumeration_clone: function(ths:PAspellModuleInfoEnumeration):PAspellModuleInfoEnumeration;cdecl;
+
+  aspell_module_info_enumeration_assign: procedure(ths:PAspellModuleInfoEnumeration; other:PAspellModuleInfoEnumeration);cdecl;
+
+  aspell_dict_info_enumeration_at_end: function(ths:PAspellDictInfoEnumeration):cint;cdecl;
+
+  aspell_dict_info_enumeration_next: function(ths:PAspellDictInfoEnumeration):PAspellDictInfo;cdecl;
+
+  delete_aspell_dict_info_enumeration: procedure(ths:PAspellDictInfoEnumeration);cdecl;
+
+  aspell_dict_info_enumeration_clone: function(ths:PAspellDictInfoEnumeration):PAspellDictInfoEnumeration;cdecl;
+
+  aspell_dict_info_enumeration_assign: procedure(ths:PAspellDictInfoEnumeration; other:PAspellDictInfoEnumeration);cdecl;
+
+      {**************************** string list **************************** }
+
+  new_aspell_string_list: function():PAspellStringList;cdecl;
+
+  aspell_string_list_empty: function(ths:PAspellStringList):cint;cdecl;
+
+  aspell_string_list_size: function(ths:PAspellStringList):cuint;cdecl;
+
+  aspell_string_list_elements: function(ths:PAspellStringList):PAspellStringEnumeration;cdecl;
+
+  aspell_string_list_add: function(ths:PAspellStringList; to_add:pchar):cint;cdecl;
+
+  aspell_string_list_remove: function(ths:PAspellStringList; to_rem:pchar):cint;cdecl;
+
+  aspell_string_list_clear: procedure(ths:PAspellStringList);cdecl;
+
+  aspell_string_list_to_mutable_container: function(ths:PAspellStringList):PAspellMutableContainer;cdecl;
+
+  delete_aspell_string_list: procedure(ths:PAspellStringList);cdecl;
+
+  aspell_string_list_clone: function(ths:PAspellStringList):PAspellStringList;cdecl;
+
+  aspell_string_list_assign: procedure(ths:PAspellStringList; other:PAspellStringList);cdecl;
+
+      {***************************** string map ***************************** }
+
+  new_aspell_string_map: function():PAspellStringMap;cdecl;
+
+  aspell_string_map_add: function(ths:PAspellStringMap; to_add:pchar):cint;cdecl;
+
+  aspell_string_map_remove: function(ths:PAspellStringMap; to_rem:pchar):cint;cdecl;
+
+  aspell_string_map_clear: procedure(ths:PAspellStringMap);cdecl;
+
+  aspell_string_map_to_mutable_container: function(ths:PAspellStringMap):PAspellMutableContainer;cdecl;
+
+  delete_aspell_string_map: procedure(ths:PAspellStringMap);cdecl;
+
+  aspell_string_map_clone: function(ths:PAspellStringMap):PAspellStringMap;cdecl;
+
+  aspell_string_map_assign: procedure(ths:PAspellStringMap; other:PAspellStringMap);cdecl;
+
+  aspell_string_map_empty: function(ths:PAspellStringMap):cint;cdecl;
+
+  aspell_string_map_size: function(ths:PAspellStringMap):cuint;cdecl;
+
+  aspell_string_map_elements: function(ths:PAspellStringMap):PAspellStringPairEnumeration;cdecl;
+
+      { Insert a new element.
+       * Will NOT overwrite an existing entry.
+       * Returns FALSE if the element already exists.  }
+
+  aspell_string_map_insert: function(ths:PAspellStringMap; key:pchar; value:pchar):cint;cdecl;
+
+      { Insert a new element.
+       * Will overwrite an existing entry.
+       * Always returns TRUE.  }
+
+  aspell_string_map_replace: function(ths:PAspellStringMap; key:pchar; value:pchar):cint;cdecl;
+
+      { Looks up an element and returns the value.
+       * Returns NULL if the element does not exist.
+       * Returns an empty string if the element exists
+       * but has a NULL value.  }
+
+  aspell_string_map_lookup: function(ths:PAspellStringMap; key:pchar):pchar;cdecl;
+
+      {********************** string pair enumeration ********************** }
+
+  aspell_string_pair_enumeration_at_end: function(ths:PAspellStringPairEnumeration):cint;cdecl;
+
+  aspell_string_pair_enumeration_next: function(ths:PAspellStringPairEnumeration):AspellStringPair;cdecl;
+
+  delete_aspell_string_pair_enumeration: procedure(ths:PAspellStringPairEnumeration);cdecl;
+
+  aspell_string_pair_enumeration_clone: function(ths:PAspellStringPairEnumeration):PAspellStringPairEnumeration;cdecl;
+
+  aspell_string_pair_enumeration_assign: procedure(ths:PAspellStringPairEnumeration; other:PAspellStringPairEnumeration);cdecl;
+
+      {******************************* cache ******************************* }
+      { Reset the global cache(s) so that cache queries will
+       * create a new object. If existing objects are still in
+       * use they are not deleted. If which is NULL then all
+       * caches will be reset. Current caches are "encode",
+       * "decode", "dictionary", "language", and "keyboard".  }
+
+  aspell_reset_cache: function(which:pchar):cint;cdecl;
+
+  function aspell_init(const libn: ansistring): Boolean;
+  function aspell_loaded: Boolean;
+  function aspell_document_checker_next_misspelling(ths:PAspellDocumentChecker):AspellToken;
+
+implementation
+
+uses
+  {$IFDEF WINDOWS}
+  Windows, SysUtils, Classes,
+  {$ENDIF}
+  dynlibs;
+
+var
+  LibHandle: TLibHandle = 0;
+
+{$IFDEF WINDOWS}
+function RegistryQueryValue (name,sub:shortstring):shortstring;
+const
+  maxkeysize=255;
+var
+  buf:string [maxkeysize];
+  bufsize:longint;
+  buftype:longint;
+  res:longint;
+  key,rkey:hkey;
+  p,sp:pchar;
+
+begin
+  RegistryQueryValue:='';
+  name:=name+#0; p:=@name[1];
+  if sub='' then sp:=nil else begin sub:=sub+#0; sp:=@sub[1]; end;
+  bufsize:=maxkeysize;
+  buftype:=REG_SZ;
+  key:=HKEY_LOCAL_MACHINE;
+  res:=RegOpenKeyEx (key,p,0,KEY_QUERY_VALUE,rkey);
+  if res<>ERROR_SUCCESS then exit;
+  res:=RegQueryValueEx (rkey,sp,nil,@buftype,@buf[1],@bufsize);
+  if res<>ERROR_SUCCESS then exit;
+  buf[0]:=chr(bufsize-1);
+  RegCloseKey (rkey);
+  RegistryQueryValue:=buf;
+end;
+{$ENDIF}
+
+function aspell_init(const libn: ansistring): Boolean;
+var
+  libname: ansistring;
+  bversion, path: ansistring;
+  version: dword;
+  i: Integer;
+  s: string;
+begin
+  aspell_init := True;
+  libname := libn;
+
+  {$IFDEF windows}
+  bversion := RegistryQueryValue('SOFTWARE\Aspell','AspellVersion');
+  if Length(bversion) >= 4 then begin
+    move(bversion[1], version, 4);
+    path := RegistryQueryValue('SOFTWARE\Aspell','Path');
+    // will work if they passed %s, won't bork if they passed absolute
+    libname := path + PathDelim + StringReplace(libn, '%s', IntToStr(Version), [rfReplaceAll]);
+  end;
+  {$ENDIF}
+
+  LibHandle := LoadLibrary(libname);
+  {$ifdef darwin}
+  if LibHandle = 0 then begin
+    libname := '/sw/lib/libaspell.dylib';
+    LibHandle := LoadLibrary(libname);
+  end;
+  if LibHandle = 0 then begin
+    libname := '/opt/local/lib/libaspell.dylib';
+    LibHandle := LoadLibrary(libname);
+  end;
+  {$else}
+    {$ifdef unix} // we're not in windblows
+  if LibHandle = 0 then begin
+    for i := 15 to 20 do begin // TODO: make sure to cut this if they break compat
+      str(i, s);
+      libname := libn + '.' + s;
+      LibHandle := LoadLibrary(libname);
+      if LibHandle <> 0 then
+        Break;
+    end;
+  end;
+    {$endif} // unix
+  {$endif} // darwin
+
+  if LibHandle = 0 then
+    Exit(False);
+
+  aspell_mutable_container_add := nil;
+  Pointer(aspell_mutable_container_add) := GetProcedureAddress(LibHandle, 'aspell_mutable_container_add');
+  if not Assigned(aspell_mutable_container_add) then Exit(False);
+
+  aspell_mutable_container_remove := nil;
+  Pointer(aspell_mutable_container_remove) := GetProcedureAddress(LibHandle, 'aspell_mutable_container_remove');
+  if not Assigned(aspell_mutable_container_remove) then Exit(False);
+
+  aspell_mutable_container_clear := nil;
+  Pointer(aspell_mutable_container_clear) := GetProcedureAddress(LibHandle, 'aspell_mutable_container_clear');
+  if not Assigned(aspell_mutable_container_clear) then Exit(False);
+
+  aspell_mutable_container_to_mutable_container := nil;
+  Pointer(aspell_mutable_container_to_mutable_container) := GetProcedureAddress(LibHandle, 'aspell_mutable_container_to_mutable_container');
+  if not Assigned(aspell_mutable_container_to_mutable_container) then Exit(False);
+
+  aspell_key_info_enumeration_at_end := nil;
+  Pointer(aspell_key_info_enumeration_at_end) := GetProcedureAddress(LibHandle, 'aspell_key_info_enumeration_at_end');
+  if not Assigned(aspell_key_info_enumeration_at_end) then Exit(False);
+
+  aspell_key_info_enumeration_next := nil;
+  Pointer(aspell_key_info_enumeration_next) := GetProcedureAddress(LibHandle, 'aspell_key_info_enumeration_next');
+  if not Assigned(aspell_key_info_enumeration_next) then Exit(False);
+
+  delete_aspell_key_info_enumeration := nil;
+  Pointer(delete_aspell_key_info_enumeration) := GetProcedureAddress(LibHandle, 'delete_aspell_key_info_enumeration');
+  if not Assigned(delete_aspell_key_info_enumeration) then Exit(False);
+
+  aspell_key_info_enumeration_clone := nil;
+  Pointer(aspell_key_info_enumeration_clone) := GetProcedureAddress(LibHandle, 'aspell_key_info_enumeration_clone');
+  if not Assigned(aspell_key_info_enumeration_clone) then Exit(False);
+
+  aspell_key_info_enumeration_assign := nil;
+  Pointer(aspell_key_info_enumeration_assign) := GetProcedureAddress(LibHandle, 'aspell_key_info_enumeration_assign');
+  if not Assigned(aspell_key_info_enumeration_assign) then Exit(False);
+
+  new_aspell_config := nil;
+  Pointer(new_aspell_config) := GetProcedureAddress(LibHandle, 'new_aspell_config');
+  if not Assigned(new_aspell_config) then Exit(False);
+
+  delete_aspell_config := nil;
+  Pointer(delete_aspell_config) := GetProcedureAddress(LibHandle, 'delete_aspell_config');
+  if not Assigned(delete_aspell_config) then Exit(False);
+
+  aspell_config_clone := nil;
+  Pointer(aspell_config_clone) := GetProcedureAddress(LibHandle, 'aspell_config_clone');
+  if not Assigned(aspell_config_clone) then Exit(False);
+
+  aspell_config_assign := nil;
+  Pointer(aspell_config_assign) := GetProcedureAddress(LibHandle, 'aspell_config_assign');
+  if not Assigned(aspell_config_assign) then Exit(False);
+
+  aspell_config_error_number := nil;
+  Pointer(aspell_config_error_number) := GetProcedureAddress(LibHandle, 'aspell_config_error_number');
+  if not Assigned(aspell_config_error_number) then Exit(False);
+
+  aspell_config_error_message := nil;
+  Pointer(aspell_config_error_message) := GetProcedureAddress(LibHandle, 'aspell_config_error_message');
+  if not Assigned(aspell_config_error_message) then Exit(False);
+
+  aspell_config_error := nil;
+  Pointer(aspell_config_error) := GetProcedureAddress(LibHandle, 'aspell_config_error');
+  if not Assigned(aspell_config_error) then Exit(False);
+
+  aspell_config_set_extra := nil;
+  Pointer(aspell_config_set_extra) := GetProcedureAddress(LibHandle, 'aspell_config_set_extra');
+  if not Assigned(aspell_config_set_extra) then Exit(False);
+
+  aspell_config_keyinfo := nil;
+  Pointer(aspell_config_keyinfo) := GetProcedureAddress(LibHandle, 'aspell_config_keyinfo');
+  if not Assigned(aspell_config_keyinfo) then Exit(False);
+
+  aspell_config_possible_elements := nil;
+  Pointer(aspell_config_possible_elements) := GetProcedureAddress(LibHandle, 'aspell_config_possible_elements');
+  if not Assigned(aspell_config_possible_elements) then Exit(False);
+
+  aspell_config_get_default := nil;
+  Pointer(aspell_config_get_default) := GetProcedureAddress(LibHandle, 'aspell_config_get_default');
+  if not Assigned(aspell_config_get_default) then Exit(False);
+
+  aspell_config_elements := nil;
+  Pointer(aspell_config_elements) := GetProcedureAddress(LibHandle, 'aspell_config_elements');
+  if not Assigned(aspell_config_elements) then Exit(False);
+
+  aspell_config_replace := nil;
+  Pointer(aspell_config_replace) := GetProcedureAddress(LibHandle, 'aspell_config_replace');
+  if not Assigned(aspell_config_replace) then Exit(False);
+
+  aspell_config_remove := nil;
+  Pointer(aspell_config_remove) := GetProcedureAddress(LibHandle, 'aspell_config_remove');
+  if not Assigned(aspell_config_remove) then Exit(False);
+
+  aspell_config_have := nil;
+  Pointer(aspell_config_have) := GetProcedureAddress(LibHandle, 'aspell_config_have');
+  if not Assigned(aspell_config_have) then Exit(False);
+
+  aspell_config_retrieve := nil;
+  Pointer(aspell_config_retrieve) := GetProcedureAddress(LibHandle, 'aspell_config_retrieve');
+  if not Assigned(aspell_config_retrieve) then Exit(False);
+
+  aspell_config_retrieve_list := nil;
+  Pointer(aspell_config_retrieve_list) := GetProcedureAddress(LibHandle, 'aspell_config_retrieve_list');
+  if not Assigned(aspell_config_retrieve_list) then Exit(False);
+
+  aspell_config_retrieve_bool := nil;
+  Pointer(aspell_config_retrieve_bool) := GetProcedureAddress(LibHandle, 'aspell_config_retrieve_bool');
+  if not Assigned(aspell_config_retrieve_bool) then Exit(False);
+
+  aspell_config_retrieve_int := nil;
+  Pointer(aspell_config_retrieve_int) := GetProcedureAddress(LibHandle, 'aspell_config_retrieve_int');
+  if not Assigned(aspell_config_retrieve_int) then Exit(False);
+
+  aspell_error_is_a := nil;
+  Pointer(aspell_error_is_a) := GetProcedureAddress(LibHandle, 'aspell_error_is_a');
+  if not Assigned(aspell_error_is_a) then Exit(False);
+
+  aspell_error_number := nil;
+  Pointer(aspell_error_number) := GetProcedureAddress(LibHandle, 'aspell_error_number');
+  if not Assigned(aspell_error_number) then Exit(False);
+
+  aspell_error_message := nil;
+  Pointer(aspell_error_message) := GetProcedureAddress(LibHandle, 'aspell_error_message');
+  if not Assigned(aspell_error_message) then Exit(False);
+
+  aspell_error := nil;
+  Pointer(aspell_error) := GetProcedureAddress(LibHandle, 'aspell_error');
+  if not Assigned(aspell_error) then Exit(False);
+
+  delete_aspell_can_have_error := nil;
+  Pointer(delete_aspell_can_have_error) := GetProcedureAddress(LibHandle, 'delete_aspell_can_have_error');
+  if not Assigned(delete_aspell_can_have_error) then Exit(False);
+
+  new_aspell_speller := nil;
+  Pointer(new_aspell_speller) := GetProcedureAddress(LibHandle, 'new_aspell_speller');
+  if not Assigned(new_aspell_speller) then Exit(False);
+
+  to_aspell_speller := nil;
+  Pointer(to_aspell_speller) := GetProcedureAddress(LibHandle, 'to_aspell_speller');
+  if not Assigned(to_aspell_speller) then Exit(False);
+
+  delete_aspell_speller := nil;
+  Pointer(delete_aspell_speller) := GetProcedureAddress(LibHandle, 'delete_aspell_speller');
+  if not Assigned(delete_aspell_speller) then Exit(False);
+
+  aspell_speller_error_number := nil;
+  Pointer(aspell_speller_error_number) := GetProcedureAddress(LibHandle, 'aspell_speller_error_number');
+  if not Assigned(aspell_speller_error_number) then Exit(False);
+
+  aspell_speller_error_message := nil;
+  Pointer(aspell_speller_error_message) := GetProcedureAddress(LibHandle, 'aspell_speller_error_message');
+  if not Assigned(aspell_speller_error_message) then Exit(False);
+
+  aspell_speller_error := nil;
+  Pointer(aspell_speller_error) := GetProcedureAddress(LibHandle, 'aspell_speller_error');
+  if not Assigned(aspell_speller_error) then Exit(False);
+
+  aspell_speller_config := nil;
+  Pointer(aspell_speller_config) := GetProcedureAddress(LibHandle, 'aspell_speller_config');
+  if not Assigned(aspell_speller_config) then Exit(False);
+
+  aspell_speller_check := nil;
+  Pointer(aspell_speller_check) := GetProcedureAddress(LibHandle, 'aspell_speller_check');
+  if not Assigned(aspell_speller_check) then Exit(False);
+
+  aspell_speller_add_to_personal := nil;
+  Pointer(aspell_speller_add_to_personal) := GetProcedureAddress(LibHandle, 'aspell_speller_add_to_personal');
+  if not Assigned(aspell_speller_add_to_personal) then Exit(False);
+
+  aspell_speller_add_to_session := nil;
+  Pointer(aspell_speller_add_to_session) := GetProcedureAddress(LibHandle, 'aspell_speller_add_to_session');
+  if not Assigned(aspell_speller_add_to_session) then Exit(False);
+
+  aspell_speller_personal_word_list := nil;
+  Pointer(aspell_speller_personal_word_list) := GetProcedureAddress(LibHandle, 'aspell_speller_personal_word_list');
+  if not Assigned(aspell_speller_personal_word_list) then Exit(False);
+
+  aspell_speller_session_word_list := nil;
+  Pointer(aspell_speller_session_word_list) := GetProcedureAddress(LibHandle, 'aspell_speller_session_word_list');
+  if not Assigned(aspell_speller_session_word_list) then Exit(False);
+
+  aspell_speller_main_word_list := nil;
+  Pointer(aspell_speller_main_word_list) := GetProcedureAddress(LibHandle, 'aspell_speller_main_word_list');
+  if not Assigned(aspell_speller_main_word_list) then Exit(False);
+
+  aspell_speller_save_all_word_lists := nil;
+  Pointer(aspell_speller_save_all_word_lists) := GetProcedureAddress(LibHandle, 'aspell_speller_save_all_word_lists');
+  if not Assigned(aspell_speller_save_all_word_lists) then Exit(False);
+
+  aspell_speller_clear_session := nil;
+  Pointer(aspell_speller_clear_session) := GetProcedureAddress(LibHandle, 'aspell_speller_clear_session');
+  if not Assigned(aspell_speller_clear_session) then Exit(False);
+
+  aspell_speller_suggest := nil;
+  Pointer(aspell_speller_suggest) := GetProcedureAddress(LibHandle, 'aspell_speller_suggest');
+  if not Assigned(aspell_speller_suggest) then Exit(False);
+
+  aspell_speller_store_replacement := nil;
+  Pointer(aspell_speller_store_replacement) := GetProcedureAddress(LibHandle, 'aspell_speller_store_replacement');
+  if not Assigned(aspell_speller_store_replacement) then Exit(False);
+
+  delete_aspell_filter := nil;
+  Pointer(delete_aspell_filter) := GetProcedureAddress(LibHandle, 'delete_aspell_filter');
+  if not Assigned(delete_aspell_filter) then Exit(False);
+
+  aspell_filter_error_number := nil;
+  Pointer(aspell_filter_error_number) := GetProcedureAddress(LibHandle, 'aspell_filter_error_number');
+  if not Assigned(aspell_filter_error_number) then Exit(False);
+
+  aspell_filter_error_message := nil;
+  Pointer(aspell_filter_error_message) := GetProcedureAddress(LibHandle, 'aspell_filter_error_message');
+  if not Assigned(aspell_filter_error_message) then Exit(False);
+
+  aspell_filter_error := nil;
+  Pointer(aspell_filter_error) := GetProcedureAddress(LibHandle, 'aspell_filter_error');
+  if not Assigned(aspell_filter_error) then Exit(False);
+
+  to_aspell_filter := nil;
+  Pointer(to_aspell_filter) := GetProcedureAddress(LibHandle, 'to_aspell_filter');
+  if not Assigned(to_aspell_filter) then Exit(False);
+
+  delete_aspell_document_checker := nil;
+  Pointer(delete_aspell_document_checker) := GetProcedureAddress(LibHandle, 'delete_aspell_document_checker');
+  if not Assigned(delete_aspell_document_checker) then Exit(False);
+
+  aspell_document_checker_error_number := nil;
+  Pointer(aspell_document_checker_error_number) := GetProcedureAddress(LibHandle, 'aspell_document_checker_error_number');
+  if not Assigned(aspell_document_checker_error_number) then Exit(False);
+
+  aspell_document_checker_error_message := nil;
+  Pointer(aspell_document_checker_error_message) := GetProcedureAddress(LibHandle, 'aspell_document_checker_error_message');
+  if not Assigned(aspell_document_checker_error_message) then Exit(False);
+
+  aspell_document_checker_error := nil;
+  Pointer(aspell_document_checker_error) := GetProcedureAddress(LibHandle, 'aspell_document_checker_error');
+  if not Assigned(aspell_document_checker_error) then Exit(False);
+
+  new_aspell_document_checker := nil;
+  Pointer(new_aspell_document_checker) := GetProcedureAddress(LibHandle, 'new_aspell_document_checker');
+  if not Assigned(new_aspell_document_checker) then Exit(False);
+
+  to_aspell_document_checker := nil;
+  Pointer(to_aspell_document_checker) := GetProcedureAddress(LibHandle, 'to_aspell_document_checker');
+  if not Assigned(to_aspell_document_checker) then Exit(False);
+
+  aspell_document_checker_reset := nil;
+  Pointer(aspell_document_checker_reset) := GetProcedureAddress(LibHandle, 'aspell_document_checker_reset');
+  if not Assigned(aspell_document_checker_reset) then Exit(False);
+
+  aspell_document_checker_process := nil;
+  Pointer(aspell_document_checker_process) := GetProcedureAddress(LibHandle, 'aspell_document_checker_process');
+  if not Assigned(aspell_document_checker_process) then Exit(False);
+
+  __aspell_document_checker_next_misspelling := nil;
+  Pointer(__aspell_document_checker_next_misspelling) := GetProcedureAddress(LibHandle, 'aspell_document_checker_next_misspelling');
+  if not Assigned(__aspell_document_checker_next_misspelling) then Exit(False);
+
+  aspell_document_checker_filter := nil;
+  Pointer(aspell_document_checker_filter) := GetProcedureAddress(LibHandle, 'aspell_document_checker_filter');
+  if not Assigned(aspell_document_checker_filter) then Exit(False);
+
+  aspell_word_list_empty := nil;
+  Pointer(aspell_word_list_empty) := GetProcedureAddress(LibHandle, 'aspell_word_list_empty');
+  if not Assigned(aspell_word_list_empty) then Exit(False);
+
+  aspell_word_list_size := nil;
+  Pointer(aspell_word_list_size) := GetProcedureAddress(LibHandle, 'aspell_word_list_size');
+  if not Assigned(aspell_word_list_size) then Exit(False);
+
+  aspell_word_list_elements := nil;
+  Pointer(aspell_word_list_elements) := GetProcedureAddress(LibHandle, 'aspell_word_list_elements');
+  if not Assigned(aspell_word_list_elements) then Exit(False);
+
+  delete_aspell_string_enumeration := nil;
+  Pointer(delete_aspell_string_enumeration) := GetProcedureAddress(LibHandle, 'delete_aspell_string_enumeration');
+  if not Assigned(delete_aspell_string_enumeration) then Exit(False);
+
+  aspell_string_enumeration_clone := nil;
+  Pointer(aspell_string_enumeration_clone) := GetProcedureAddress(LibHandle, 'aspell_string_enumeration_clone');
+  if not Assigned(aspell_string_enumeration_clone) then Exit(False);
+
+  aspell_string_enumeration_assign := nil;
+  Pointer(aspell_string_enumeration_assign) := GetProcedureAddress(LibHandle, 'aspell_string_enumeration_assign');
+  if not Assigned(aspell_string_enumeration_assign) then Exit(False);
+
+  aspell_string_enumeration_at_end := nil;
+  Pointer(aspell_string_enumeration_at_end) := GetProcedureAddress(LibHandle, 'aspell_string_enumeration_at_end');
+  if not Assigned(aspell_string_enumeration_at_end) then Exit(False);
+
+  aspell_string_enumeration_next := nil;
+  Pointer(aspell_string_enumeration_next) := GetProcedureAddress(LibHandle, 'aspell_string_enumeration_next');
+  if not Assigned(aspell_string_enumeration_next) then Exit(False);
+
+  get_aspell_module_info_list := nil;
+  Pointer(get_aspell_module_info_list) := GetProcedureAddress(LibHandle, 'get_aspell_module_info_list');
+  if not Assigned(get_aspell_module_info_list) then Exit(False);
+
+  aspell_module_info_list_empty := nil;
+  Pointer(aspell_module_info_list_empty) := GetProcedureAddress(LibHandle, 'aspell_module_info_list_empty');
+  if not Assigned(aspell_module_info_list_empty) then Exit(False);
+
+  aspell_module_info_list_size := nil;
+  Pointer(aspell_module_info_list_size) := GetProcedureAddress(LibHandle, 'aspell_module_info_list_size');
+  if not Assigned(aspell_module_info_list_size) then Exit(False);
+
+  aspell_module_info_list_elements := nil;
+  Pointer(aspell_module_info_list_elements) := GetProcedureAddress(LibHandle, 'aspell_module_info_list_elements');
+  if not Assigned(aspell_module_info_list_elements) then Exit(False);
+
+  get_aspell_dict_info_list := nil;
+  Pointer(get_aspell_dict_info_list) := GetProcedureAddress(LibHandle, 'get_aspell_dict_info_list');
+  if not Assigned(get_aspell_dict_info_list) then Exit(False);
+
+  aspell_dict_info_list_empty := nil;
+  Pointer(aspell_dict_info_list_empty) := GetProcedureAddress(LibHandle, 'aspell_dict_info_list_empty');
+  if not Assigned(aspell_dict_info_list_empty) then Exit(False);
+
+  aspell_dict_info_list_size := nil;
+  Pointer(aspell_dict_info_list_size) := GetProcedureAddress(LibHandle, 'aspell_dict_info_list_size');
+  if not Assigned(aspell_dict_info_list_size) then Exit(False);
+
+  aspell_dict_info_list_elements := nil;
+  Pointer(aspell_dict_info_list_elements) := GetProcedureAddress(LibHandle, 'aspell_dict_info_list_elements');
+  if not Assigned(aspell_dict_info_list_elements) then Exit(False);
+
+  aspell_module_info_enumeration_at_end := nil;
+  Pointer(aspell_module_info_enumeration_at_end) := GetProcedureAddress(LibHandle, 'aspell_module_info_enumeration_at_end');
+  if not Assigned(aspell_module_info_enumeration_at_end) then Exit(False);
+
+  aspell_module_info_enumeration_next := nil;
+  Pointer(aspell_module_info_enumeration_next) := GetProcedureAddress(LibHandle, 'aspell_module_info_enumeration_next');
+  if not Assigned(aspell_module_info_enumeration_next) then Exit(False);
+
+  delete_aspell_module_info_enumeration := nil;
+  Pointer(delete_aspell_module_info_enumeration) := GetProcedureAddress(LibHandle, 'delete_aspell_module_info_enumeration');
+  if not Assigned(delete_aspell_module_info_enumeration) then Exit(False);
+
+  aspell_module_info_enumeration_clone := nil;
+  Pointer(aspell_module_info_enumeration_clone) := GetProcedureAddress(LibHandle, 'aspell_module_info_enumeration_clone');
+  if not Assigned(aspell_module_info_enumeration_clone) then Exit(False);
+
+  aspell_module_info_enumeration_assign := nil;
+  Pointer(aspell_module_info_enumeration_assign) := GetProcedureAddress(LibHandle, 'aspell_module_info_enumeration_assign');
+  if not Assigned(aspell_module_info_enumeration_assign) then Exit(False);
+
+  aspell_dict_info_enumeration_at_end := nil;
+  Pointer(aspell_dict_info_enumeration_at_end) := GetProcedureAddress(LibHandle, 'aspell_dict_info_enumeration_at_end');
+  if not Assigned(aspell_dict_info_enumeration_at_end) then Exit(False);
+
+  aspell_dict_info_enumeration_next := nil;
+  Pointer(aspell_dict_info_enumeration_next) := GetProcedureAddress(LibHandle, 'aspell_dict_info_enumeration_next');
+  if not Assigned(aspell_dict_info_enumeration_next) then Exit(False);
+
+  delete_aspell_dict_info_enumeration := nil;
+  Pointer(delete_aspell_dict_info_enumeration) := GetProcedureAddress(LibHandle, 'delete_aspell_dict_info_enumeration');
+  if not Assigned(delete_aspell_dict_info_enumeration) then Exit(False);
+
+  aspell_dict_info_enumeration_clone := nil;
+  Pointer(aspell_dict_info_enumeration_clone) := GetProcedureAddress(LibHandle, 'aspell_dict_info_enumeration_clone');
+  if not Assigned(aspell_dict_info_enumeration_clone) then Exit(False);
+
+  aspell_dict_info_enumeration_assign := nil;
+  Pointer(aspell_dict_info_enumeration_assign) := GetProcedureAddress(LibHandle, 'aspell_dict_info_enumeration_assign');
+  if not Assigned(aspell_dict_info_enumeration_assign) then Exit(False);
+
+  new_aspell_string_list := nil;
+  Pointer(new_aspell_string_list) := GetProcedureAddress(LibHandle, 'new_aspell_string_list');
+  if not Assigned(new_aspell_string_list) then Exit(False);
+
+  aspell_string_list_empty := nil;
+  Pointer(aspell_string_list_empty) := GetProcedureAddress(LibHandle, 'aspell_string_list_empty');
+  if not Assigned(aspell_string_list_empty) then Exit(False);
+
+  aspell_string_list_size := nil;
+  Pointer(aspell_string_list_size) := GetProcedureAddress(LibHandle, 'aspell_string_list_size');
+  if not Assigned(aspell_string_list_size) then Exit(False);
+
+  aspell_string_list_elements := nil;
+  Pointer(aspell_string_list_elements) := GetProcedureAddress(LibHandle, 'aspell_string_list_elements');
+  if not Assigned(aspell_string_list_elements) then Exit(False);
+
+  aspell_string_list_add := nil;
+  Pointer(aspell_string_list_add) := GetProcedureAddress(LibHandle, 'aspell_string_list_add');
+  if not Assigned(aspell_string_list_add) then Exit(False);
+
+  aspell_string_list_remove := nil;
+  Pointer(aspell_string_list_remove) := GetProcedureAddress(LibHandle, 'aspell_string_list_remove');
+  if not Assigned(aspell_string_list_remove) then Exit(False);
+
+  aspell_string_list_clear := nil;
+  Pointer(aspell_string_list_clear) := GetProcedureAddress(LibHandle, 'aspell_string_list_clear');
+  if not Assigned(aspell_string_list_clear) then Exit(False);
+
+  aspell_string_list_to_mutable_container := nil;
+  Pointer(aspell_string_list_to_mutable_container) := GetProcedureAddress(LibHandle, 'aspell_string_list_to_mutable_container');
+  if not Assigned(aspell_string_list_to_mutable_container) then Exit(False);
+
+  delete_aspell_string_list := nil;
+  Pointer(delete_aspell_string_list) := GetProcedureAddress(LibHandle, 'delete_aspell_string_list');
+  if not Assigned(delete_aspell_string_list) then Exit(False);
+
+  aspell_string_list_clone := nil;
+  Pointer(aspell_string_list_clone) := GetProcedureAddress(LibHandle, 'aspell_string_list_clone');
+  if not Assigned(aspell_string_list_clone) then Exit(False);
+
+  aspell_string_list_assign := nil;
+  Pointer(aspell_string_list_assign) := GetProcedureAddress(LibHandle, 'aspell_string_list_assign');
+  if not Assigned(aspell_string_list_assign) then Exit(False);
+
+  new_aspell_string_map := nil;
+  Pointer(new_aspell_string_map) := GetProcedureAddress(LibHandle, 'new_aspell_string_map');
+  if not Assigned(new_aspell_string_map) then Exit(False);
+
+  aspell_string_map_add := nil;
+  Pointer(aspell_string_map_add) := GetProcedureAddress(LibHandle, 'aspell_string_map_add');
+  if not Assigned(aspell_string_map_add) then Exit(False);
+
+  aspell_string_map_remove := nil;
+  Pointer(aspell_string_map_remove) := GetProcedureAddress(LibHandle, 'aspell_string_map_remove');
+  if not Assigned(aspell_string_map_remove) then Exit(False);
+
+  aspell_string_map_clear := nil;
+  Pointer(aspell_string_map_clear) := GetProcedureAddress(LibHandle, 'aspell_string_map_clear');
+  if not Assigned(aspell_string_map_clear) then Exit(False);
+
+  aspell_string_map_to_mutable_container := nil;
+  Pointer(aspell_string_map_to_mutable_container) := GetProcedureAddress(LibHandle, 'aspell_string_map_to_mutable_container');
+  if not Assigned(aspell_string_map_to_mutable_container) then Exit(False);
+
+  delete_aspell_string_map := nil;
+  Pointer(delete_aspell_string_map) := GetProcedureAddress(LibHandle, 'delete_aspell_string_map');
+  if not Assigned(delete_aspell_string_map) then Exit(False);
+
+  aspell_string_map_clone := nil;
+  Pointer(aspell_string_map_clone) := GetProcedureAddress(LibHandle, 'aspell_string_map_clone');
+  if not Assigned(aspell_string_map_clone) then Exit(False);
+
+  aspell_string_map_assign := nil;
+  Pointer(aspell_string_map_assign) := GetProcedureAddress(LibHandle, 'aspell_string_map_assign');
+  if not Assigned(aspell_string_map_assign) then Exit(False);
+
+  aspell_string_map_empty := nil;
+  Pointer(aspell_string_map_empty) := GetProcedureAddress(LibHandle, 'aspell_string_map_empty');
+  if not Assigned(aspell_string_map_empty) then Exit(False);
+
+  aspell_string_map_size := nil;
+  Pointer(aspell_string_map_size) := GetProcedureAddress(LibHandle, 'aspell_string_map_size');
+  if not Assigned(aspell_string_map_size) then Exit(False);
+
+  aspell_string_map_elements := nil;
+  Pointer(aspell_string_map_elements) := GetProcedureAddress(LibHandle, 'aspell_string_map_elements');
+  if not Assigned(aspell_string_map_elements) then Exit(False);
+
+  aspell_string_map_insert := nil;
+  Pointer(aspell_string_map_insert) := GetProcedureAddress(LibHandle, 'aspell_string_map_insert');
+  if not Assigned(aspell_string_map_insert) then Exit(False);
+
+  aspell_string_map_replace := nil;
+  Pointer(aspell_string_map_replace) := GetProcedureAddress(LibHandle, 'aspell_string_map_replace');
+  if not Assigned(aspell_string_map_replace) then Exit(False);
+
+  aspell_string_map_lookup := nil;
+  Pointer(aspell_string_map_lookup) := GetProcedureAddress(LibHandle, 'aspell_string_map_lookup');
+  if not Assigned(aspell_string_map_lookup) then Exit(False);
+
+  aspell_string_pair_enumeration_at_end := nil;
+  Pointer(aspell_string_pair_enumeration_at_end) := GetProcedureAddress(LibHandle, 'aspell_string_pair_enumeration_at_end');
+  if not Assigned(aspell_string_pair_enumeration_at_end) then Exit(False);
+
+  aspell_string_pair_enumeration_next := nil;
+  Pointer(aspell_string_pair_enumeration_next) := GetProcedureAddress(LibHandle, 'aspell_string_pair_enumeration_next');
+  if not Assigned(aspell_string_pair_enumeration_next) then Exit(False);
+
+  delete_aspell_string_pair_enumeration := nil;
+  Pointer(delete_aspell_string_pair_enumeration) := GetProcedureAddress(LibHandle, 'delete_aspell_string_pair_enumeration');
+  if not Assigned(delete_aspell_string_pair_enumeration) then Exit(False);
+
+  aspell_string_pair_enumeration_clone := nil;
+  Pointer(aspell_string_pair_enumeration_clone) := GetProcedureAddress(LibHandle, 'aspell_string_pair_enumeration_clone');
+  if not Assigned(aspell_string_pair_enumeration_clone) then Exit(False);
+
+  aspell_string_pair_enumeration_assign := nil;
+  Pointer(aspell_string_pair_enumeration_assign) := GetProcedureAddress(LibHandle, 'aspell_string_pair_enumeration_assign');
+  if not Assigned(aspell_string_pair_enumeration_assign) then Exit(False);
+
+  aspell_reset_cache := nil;
+  Pointer(aspell_reset_cache) := GetProcedureAddress(LibHandle, 'aspell_reset_cache');
+  if not Assigned(aspell_reset_cache) then Exit(False);
+end;
+
+function aspell_loaded: Boolean;
+begin
+  aspell_loaded := LibHandle <> 0;
+end;
+
+function aspell_document_checker_next_misspelling(ths: PAspellDocumentChecker
+  ): AspellToken;
+begin
+  // yup...
+  aspell_document_checker_next_misspelling := AspellToken(__aspell_document_checker_next_misspelling(ths));
+end;
+
+initialization
+  aspell_init(libaspell);
+
+finalization
+  if LibHandle <> 0 then
+    UnloadLibrary(LibHandle);
+
+end.

packages/aspell/src/aspelltypes.inc

@@ -0,0 +1,119 @@
+    type
+      PAspellCanHaveError  = Pointer;
+      PAspellConfig  = Pointer;
+      PAspellDictInfoEnumeration  = Pointer;
+      PAspellDictInfoList  = Pointer;
+      PAspellDocumentChecker  = Pointer;
+      PAspellFilter  = Pointer;
+      PAspellKeyInfoEnumeration  = Pointer;
+      PAspellModuleInfoEnumeration  = Pointer;
+      PAspellModuleInfoList  = Pointer;
+      PAspellMutableContainer  = Pointer;
+      PAspellSpeller  = Pointer;
+      PAspellStringEnumeration  = Pointer;
+      PAspellStringList  = Pointer;
+      PAspellStringMap  = Pointer;
+      PAspellStringPairEnumeration  = Pointer;
+      PAspellWordList  = Pointer;
+
+  {****************************** type id ****************************** }
+
+   type
+     PAspellTypeId = ^AspellTypeId;
+     AspellTypeId = record
+         case longint of
+            0 : ( num : cuint );
+            1 : ( str : array[0..3] of char );
+         end;
+
+    {****************************** key info ****************************** }
+
+       PAspellKeyInfoType = ^AspellKeyInfoType;
+       AspellKeyInfoType = (AspellKeyInfoString,AspellKeyInfoInt,
+         AspellKeyInfoBool,AspellKeyInfoList
+         );
+
+    { A brief description of the key or NULL if internal value.  }
+
+       PAspellKeyInfo = ^AspellKeyInfo;
+       AspellKeyInfo = record
+            name : pchar;
+            _type : AspellKeyInfoType;
+            def : pchar;
+            desc : pchar;
+            flags : cint;
+            other_data : cint;
+         end;
+
+    {****************************** error ****************************** }
+
+       PAspellErrorInfo = ^AspellErrorInfo;
+       AspellErrorInfo = record
+            isa : PAspellErrorInfo;
+            mesg : pchar;
+            num_parms : cuint;
+            parms : array[0..2] of pchar;
+         end;
+
+       PAspellError = ^AspellError;
+       AspellError = record
+            mesg : pchar;
+            err : PAspellErrorInfo;
+         end;
+
+    {****************************** token ****************************** }
+
+       PAspellToken = ^AspellToken;
+       AspellToken = record
+            offset : cuint;
+            len : cuint;
+         end;
+
+    {*************************** module/dict *************************** }
+
+       PAspellModuleInfo = ^AspellModuleInfo;
+       AspellModuleInfo = record
+            name : pchar;
+            order_num : double;
+            lib_dir : pchar;
+            dict_dirs : PAspellStringList;
+            dict_exts : PAspellStringList;
+         end;
+
+    { The Name to identify this dictionary by.  }
+
+    { The language code to identify this dictionary.
+       * A two letter UPPER-CASE ISO 639 language code
+       * and an optional two letter ISO 3166 country
+       * code after a dash or underscore.  }
+
+    { Any extra information to distinguish this
+       * variety of dictionary from other dictionaries
+       * which may have the same language and size.  }
+
+    { A two char digit code describing the size of
+       * the dictionary: 10=tiny, 20=really small,
+       * 30=small, 40=med-small, 50=med, 60=med-large,
+       * 70=large, 80=huge, 90=insane.  Please check
+       * the README in aspell-lang-200?????.tar.bz2 or
+       * see SCOWL (http://wordlist.sourceforge.net)
+       * for an example of how these sizes are used.  }
+
+       PAspellDictInfo = ^AspellDictInfo;
+       AspellDictInfo = record
+            name : pchar;
+            code : pchar;
+            jargon : pchar;
+            size : cint;
+            size_str : pchar;
+            module : PAspellModuleInfo;
+         end;
+
+  {**************************** string pair **************************** }
+
+       PAspellStringPair = ^AspellStringPair;
+       AspellStringPair = record
+            first : pchar;
+            second : pchar;
+         end;
+

packages/aspell/src/spellcheck.pp

@@ -23,8 +23,7 @@ type
   TLineErrors = array of TWordError;
   TLineErrorsArray = array of TLineErrors;
 
-  { TSpeller }
-  { Abstract ancestor, don't use directly }
+  { TSpellCheck }
 
   TSpeller = class // abstract class, basis for all checkers
    protected
@@ -44,13 +43,14 @@ type
     property Encoding: string read FEncoding write SetEncoding;
     property Language: string read FLanguage write SetLanguage;
   end;
-
-  { TWordSpeller }
-  { Basic spelling class for spelling single words without context }
   
+  { TWordSpeller }
+
   TWordSpeller = class(TSpeller) // class for simple per-word checking
    private
     FSpeller: PAspellSpeller;
+    FLastError: string;
+    function DoCreateSpeller(Lang, Enc, aMode: pChar): PAspellSpeller;
    protected
     procedure CreateSpeller; override;
     procedure FreeSpeller; override;
@@ -59,9 +59,6 @@ type
   end;
   
   { TDocumentSpeller }
-  { This speller is used to spellcheck lines or even whole documents.
-    It is usefull when different mode (like "tex") is used so you can pass
-    everything to aspell and let it take care of the context }
 
   TDocumentSpeller = class(TWordSpeller)
    private
@@ -136,29 +133,48 @@ end;
 
 { TWordSpeller }
 
-procedure TWordSpeller.CreateSpeller;
+function TWordSpeller.DoCreateSpeller(Lang, Enc, aMode: pChar): PAspellSpeller;
 var
-  Config: Paspellconfig;
   Error: Paspellcanhaveerror;
 begin
-  Config := new_aspell_config();
+  Result := new_aspell_config();
 
   if Length(FLanguage) > 0 then
-    aspell_config_replace(Config, 'lang', pChar(FLanguage));
+    aspell_config_replace(Result, 'lang', Lang);
   if Length(FEncoding) > 0 then
-    aspell_config_replace(Config, 'encoding', pChar(FEncoding));
+    aspell_config_replace(Result, 'encoding', Enc);
   if Length(FMode) > 0 then
-    aspell_config_replace(Config, 'mode', pChar(FMode));
+    aspell_config_replace(Result, 'mode', aMode);
+
+  Error := new_aspell_speller(Result);
 
-  Error := new_aspell_speller(Config);
+  delete_aspell_config(Result);
 
-  delete_aspell_config(Config);
+  if aspell_error_number(Error) <> 0 then begin
+    FLastError := aspell_error_message(Error);
+    delete_aspell_can_have_error(Error);
+    Result := nil;
+  end else
+    Result := to_aspell_speller(Error);
+end;
+
+procedure TWordSpeller.CreateSpeller;
+begin
+  FLastError := '';
   FreeSpeller;
 
-  if aspell_error_number(Error) <> 0 then
-    raise Exception.Create('Error on speller creation: ' + aspell_error_message(Error))
-  else
-    FSpeller := to_aspell_speller(Error);
+  FSpeller := DoCreateSpeller(pChar(FLanguage), pChar(FEncoding), pChar(FMode));
+  if not Assigned(FSpeller) then
+    FSpeller := DoCreateSpeller(nil, pChar(FEncoding), pChar(FMode));
+  if not Assigned(FSpeller) then
+    FSpeller := DoCreateSpeller(nil, pChar(FEncoding), nil);
+  if not Assigned(FSpeller) then
+    FSpeller := DoCreateSpeller(nil, nil, pChar(FMode));
+  if not Assigned(FSpeller) then
+    FSpeller := DoCreateSpeller(nil, nil, nil);
+
+  if not Assigned(FSpeller) then
+    raise Exception.Create('Error on speller creation: ' + FLastError);
 end;
 
 procedure TWordSpeller.FreeSpeller;

packages/cdrom/src/fpcddb.pp

@@ -520,14 +520,15 @@ begin
       Result:=1;
       Exit;
       end
-    else if (CmdRes<>210) then
+    else if not (CmdRes in [210,211]) then
       Raise ECDDBParser.CreateFmt(SerrCDDBResponse,[L]);
     end;
-  For I:=Ord(WithHeader) to Response.Count-1 do
-    begin
-    SplitQueryResponse(Response[i],C,D,T,P);
-    Matches.AddMatch(D,C,T,P);
-    end;
+  For I:=Ord(WithHeader or (CMDRes=211)) to Response.Count-1 do
+    If (Response[i]<>'.') then
+      begin
+      SplitQueryResponse(Response[i],C,D,T,P);
+      Matches.AddMatch(D,C,T,P);
+      end;
   Result:=Matches.Count;
 end;
 

packages/chm/src/chmsitemap.pas

@@ -46,9 +46,10 @@ type
     FText: String;
     FURL: String;
     procedure SetChildren(const AValue: TChmSiteMapItems);
-  published
+  public
     constructor Create(AOwner: TChmSiteMapItems);
     destructor Destroy; override;
+  published
     property Children: TChmSiteMapItems read FChildren write SetChildren;
     property Text: String read FText write FText; // Name for TOC; KeyWord for index
     property KeyWord: String read FKeyWord write FKeyWord;
@@ -349,8 +350,8 @@ var
          WriteParam('Keyword', Item.Text);
       //if Item.KeyWord <> '' then WriteParam('Keyword', Item.KeyWord);
       if Item.Text <> '' then WriteParam('Name', Item.Text);
-      if (Item.Local <> '') or (SiteMapType = stIndex) then WriteParam('Local', Item.Local);
-      if Item.URL <> '' then WriteParam('URL', Item.URL);
+      if (Item.Local <> '') or (SiteMapType = stIndex) then WriteParam('Local', StringReplace(Item.Local, '\', '/', [rfReplaceAll]));
+      if Item.URL <> '' then WriteParam('URL', StringReplace(Item.URL, '\', '/', [rfReplaceAll]));
       if (SiteMapType = stIndex) and (Item.SeeAlso <> '') then WriteParam('See Also', Item.SeeAlso);
       //if Item.FrameName <> '' then WriteParam('FrameName', Item.FrameName);
       //if Item.WindowName <> '' then WriteParam('WindowName', Item.WindowName);

packages/fcl-base/Makefile

@@ -1,5 +1,5 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2008/11/02]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2008/11/23]
 #
 default: all
 MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded avr-embedded armeb-linux armeb-embedded
@@ -800,178 +800,178 @@ ifeq ($(FULL_TARGET),armeb-embedded)
 override COMPILER_OPTIONS+=-S2h
 endif
 ifeq ($(FULL_TARGET),i386-linux)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy  src/unix
 endif
 ifeq ($(FULL_TARGET),i386-go32v2)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy
 endif
 ifeq ($(FULL_TARGET),i386-win32)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/win
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy  src/win
 endif
 ifeq ($(FULL_TARGET),i386-os2)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy
 endif
 ifeq ($(FULL_TARGET),i386-freebsd)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy  src/unix
 endif
 ifeq ($(FULL_TARGET),i386-beos)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy  src/unix
 endif
 ifeq ($(FULL_TARGET),i386-haiku)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy  src/unix
 endif
 ifeq ($(FULL_TARGET),i386-netbsd)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy  src/unix
 endif
 ifeq ($(FULL_TARGET),i386-solaris)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy  src/unix
 endif
 ifeq ($(FULL_TARGET),i386-qnx)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy  src/unix
 endif
 ifeq ($(FULL_TARGET),i386-netware)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy
 endif
 ifeq ($(FULL_TARGET),i386-openbsd)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy  src/unix
 endif
 ifeq ($(FULL_TARGET),i386-wdosx)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy
 endif
 ifeq ($(FULL_TARGET),i386-darwin)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy  src/unix
 endif
 ifeq ($(FULL_TARGET),i386-emx)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/os2
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy  src/os2
 endif
 ifeq ($(FULL_TARGET),i386-watcom)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy
 endif
 ifeq ($(FULL_TARGET),i386-netwlibc)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy
 endif
 ifeq ($(FULL_TARGET),i386-wince)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/win
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy  src/win
 endif
 ifeq ($(FULL_TARGET),i386-embedded)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy
 endif
 ifeq ($(FULL_TARGET),i386-symbian)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy
 endif
 ifeq ($(FULL_TARGET),m68k-linux)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy  src/unix
 endif
 ifeq ($(FULL_TARGET),m68k-freebsd)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy  src/unix
 endif
 ifeq ($(FULL_TARGET),m68k-netbsd)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy  src/unix
 endif
 ifeq ($(FULL_TARGET),m68k-amiga)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy
 endif
 ifeq ($(FULL_TARGET),m68k-atari)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy
 endif
 ifeq ($(FULL_TARGET),m68k-openbsd)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy  src/unix
 endif
 ifeq ($(FULL_TARGET),m68k-palmos)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy
 endif
 ifeq ($(FULL_TARGET),m68k-embedded)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy
 endif
 ifeq ($(FULL_TARGET),powerpc-linux)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy  src/unix
 endif
 ifeq ($(FULL_TARGET),powerpc-netbsd)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy  src/unix
 endif
 ifeq ($(FULL_TARGET),powerpc-amiga)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy
 endif
 ifeq ($(FULL_TARGET),powerpc-macos)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy
 endif
 ifeq ($(FULL_TARGET),powerpc-darwin)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy  src/unix
 endif
 ifeq ($(FULL_TARGET),powerpc-morphos)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy
 endif
 ifeq ($(FULL_TARGET),powerpc-embedded)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy
 endif
 ifeq ($(FULL_TARGET),sparc-linux)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy  src/unix
 endif
 ifeq ($(FULL_TARGET),sparc-netbsd)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy  src/unix
 endif
 ifeq ($(FULL_TARGET),sparc-solaris)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy  src/unix
 endif
 ifeq ($(FULL_TARGET),sparc-embedded)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy
 endif
 ifeq ($(FULL_TARGET),x86_64-linux)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy  src/unix
 endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy  src/unix
 endif
 ifeq ($(FULL_TARGET),x86_64-darwin)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy  src/unix
 endif
 ifeq ($(FULL_TARGET),x86_64-win64)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/win
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy  src/win
 endif
 ifeq ($(FULL_TARGET),x86_64-embedded)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy
 endif
 ifeq ($(FULL_TARGET),arm-linux)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy  src/unix
 endif
 ifeq ($(FULL_TARGET),arm-palmos)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy
 endif
 ifeq ($(FULL_TARGET),arm-darwin)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy  src/unix
 endif
 ifeq ($(FULL_TARGET),arm-wince)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/win
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy  src/win
 endif
 ifeq ($(FULL_TARGET),arm-gba)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy
 endif
 ifeq ($(FULL_TARGET),arm-nds)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy
 endif
 ifeq ($(FULL_TARGET),arm-embedded)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy
 endif
 ifeq ($(FULL_TARGET),arm-symbian)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy
 endif
 ifeq ($(FULL_TARGET),powerpc64-linux)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy  src/unix
 endif
 ifeq ($(FULL_TARGET),powerpc64-darwin)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy  src/unix
 endif
 ifeq ($(FULL_TARGET),powerpc64-embedded)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy
 endif
 ifeq ($(FULL_TARGET),avr-embedded)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy
 endif
 ifeq ($(FULL_TARGET),armeb-linux)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy  src/unix
 endif
 ifeq ($(FULL_TARGET),armeb-embedded)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src src/dummy
 endif
 ifeq ($(FULL_TARGET),i386-linux)
 override COMPILER_SOURCEDIR+=src/$(OS_TARGET) src

packages/fcl-base/Makefile.fpc

@@ -34,7 +34,7 @@ rsts=cachecls custapp cgiapp eventlog registry streamcoll inicol
 
 [compiler]
 options=-S2h
-includedir=src/$(OS_TARGET) src
+includedir=src/$(OS_TARGET) src src/dummy
 includedir_linux=src/unix
 includedir_freebsd=src/unix
 includedir_darwin=src/unix
@@ -49,7 +49,6 @@ includedir_win32=src/win
 includedir_win64=src/win
 includedir_wince=src/win
 sourcedir=src/$(OS_TARGET) src
-includedir_linux=src/dummy
 
 [prerules]
 ifeq ($(OS_TARGET),win32)

packages/fcl-base/src/gettext.pp

@@ -234,7 +234,7 @@ end;
 {$ifdef windows}
 procedure GetLanguageIDs(var Lang, FallbackLang: string);
 var
-  Buffer: array[1..4] of char;
+  Buffer: array[1..4] of {$ifdef Wince}WideChar{$else}char{$endif};
   Country: string;
   UserLCID: LCID;
 begin

packages/fcl-db/src/base/bufdataset.pas

@@ -144,6 +144,7 @@ type
     procedure StoreCurrentRecIntoBookmark(const ABookmark: PBufBookmark);  virtual; abstract;
     procedure StoreSpareRecIntoBookmark(const ABookmark: PBufBookmark);  virtual; abstract;
     procedure GotoBookmark(const ABookmark : PBufBookmark); virtual; abstract;
+    function BookmarkValid(const ABookmark: PBufBookmark): boolean; virtual;
 
     procedure InitialiseIndex; virtual; abstract;
 
@@ -467,6 +468,7 @@ type
     procedure LoadFromFile(AFileName: string = ''; Format: TDataPacketFormat = dfAny);
     procedure SaveToFile(AFileName: string = ''; Format: TDataPacketFormat = dfBinary);
     procedure CreateDataset;
+    function BookmarkValid(ABookmark: TBookmark): Boolean; override;
     function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Longint; override;
 
     property ChangeCount : Integer read GetChangeCount;
@@ -1041,6 +1043,11 @@ begin
   FDataset := ADataset;
 end;
 
+function TBufIndex.BookmarkValid(const ABookmark: PBufBookmark): boolean;
+begin
+  Result := assigned(ABookmark) and assigned(ABookmark^.BookmarkData);
+end;
+
 function TBufIndex.CompareBookmarks(const ABookmark1, ABookmark2: PBufBookmark): boolean;
 begin
   result := (ABookmark1^.BookmarkData=ABookmark2^.BookmarkData);
@@ -1169,6 +1176,7 @@ procedure TDoubleLinkedBufIndex.RemoveRecordFromIndex(const ABookmark : TBufBook
 var ARecord : PBufRecLinkItem;
 begin
   ARecord := ABookmark.BookmarkData;
+  if ARecord = FCurrentRecBuf then DoScrollForward;
   if ARecord <> FFirstRecBuf then
     ARecord[IndNr].prior[IndNr].next := ARecord[IndNr].next
   else
@@ -1177,7 +1185,6 @@ begin
     FLastRecBuf[IndNr].next := FFirstRecBuf;
     end;
   ARecord[IndNr].next[IndNr].prior := ARecord[IndNr].prior;
-  DoScrollForward;
 end;
 
 function TDoubleLinkedBufIndex.GetRecNo(const ABookmark: PBufBookmark): integer;
@@ -1398,59 +1405,6 @@ begin
   FCurrentIndex.GotoBookmark(ABookmark);
 end;
 
-(*
-procedure TBufDataset.AddRecordToIndex(var AIndex: TBufIndex; ARecBuf : pchar);
-var cp : integer;
-    NewValueBufLen : Integer;
-    NewValueBuf,CompValueBuf : pchar;
-    RecInd : integer;
-    HighVal,LowVal : Integer;
-begin
-  if not assigned(AIndex.Fields) then
-    AIndex.Fields := FieldByName(AIndex.FieldsName);
-
-  NewValueBuf:=pchar(ARecBuf);
-  inc(NewValueBuf,FFieldBufPositions[AIndex.Fields.FieldNo-1]);
-
-  NewValueBufLen:= Length(NewValueBuf);
-  HighVal := AIndex.FLastRecInd;
-  LowVal := 0;
-
-  repeat
-  RecInd := lowval+((HighVal-LowVal) div 2);
-  CompValueBuf:=AIndex.FRecordArray[RecInd]+FFieldBufPositions[AIndex.Fields.FieldNo-1];
-  if AIndex.Fields.DataType = ftString then
-    begin
-    cp := DBCompareText(NewValueBuf,CompValueBuf,NewValueBufLen,[]);
-    if cp >0 then
-      LowVal := RecInd
-    else
-      HighVal := RecInd;
-    end;
-  until abs(HighVal-LowVal)<2;
-  if cp <0 then RecInd:=RecInd else RecInd := RecInd+1;
-  if recind > AIndex.FLastRecInd then recind := AIndex.FLastRecInd;
-{
-  Write('New: ' + NewValueBuf);
-  Write(' Verg: ' + CompValueBuf);
-  CompValueBuf:=AIndex.FRecordArray[LowVal]+FFieldBufPositions[AIndex.SortField.FieldNo-1];
-  Write(' Low: ' + CompValueBuf + '('+inttostr(LowVal)+')');
-  CompValueBuf:=AIndex.FRecordArray[HighVal]+FFieldBufPositions[AIndex.SortField.FieldNo-1];
-  Write(' High: ' + CompValueBuf + '('+inttostr(HighVal)+')');
-  CompValueBuf:=AIndex.FRecordArray[RecInd]+FFieldBufPositions[AIndex.SortField.FieldNo-1];
-  Write(' RecIND: ' + CompValueBuf + '('+inttostr(RecInd)+')');
-  Writeln(' cp: ' + inttostr(cp));
-}
-
-  if (AIndex.FLastRecInd+1) >= length(AIndex.FRecordArray) then
-    SetLength(AIndex.FRecordArray,length(AIndex.FRecordArray)+FGrowBuffer);
-
-  move(AIndex.FRecordArray[RecInd],AIndex.FRecordArray[RecInd+1],sizeof(pointer)*(AIndex.FLastRecInd-RecInd+5)); // Let op. Moet zijn +1?
-  AIndex.FRecordArray[RecInd]:= ARecBuf;
-  inc(AIndex.FLastRecInd)
-end;
-*)
-
 function TBufDataset.getnextpacket : integer;
 
 var i : integer;
@@ -1723,12 +1677,7 @@ begin
   for i := StartInd to FIndexesCount-1 do
     findexes[i].RemoveRecordFromIndex(RemRecBookmrk);
 
-// If a modified record is deleted, and GetRecordUpdateBuffer is used, problems
-// may arise. The 'delete' is placed in the update-buffer before the actual delete
-// took place. This can lead into troubles, because other updates can depend on
-// the record still being available.
-  if not GetActiveRecordUpdateBuffer or
-    (FUpdateBuffer[FCurrentUpdateBuffer].UpdateKind = ukModify) then
+  if not GetActiveRecordUpdateBuffer then
     begin
     FCurrentUpdateBuffer := length(FUpdateBuffer);
     SetLength(FUpdateBuffer,FCurrentUpdateBuffer+1);
@@ -1780,10 +1729,63 @@ begin
 end;
 
 procedure TBufDataset.CancelUpdates;
+var StoreRecBM     : TBufBookmark;
+  procedure CancelUpdBuffer(var AUpdBuffer : TRecUpdateBuffer);
+  var
+    TmpBuf         : PChar;
+    StoreUpdBuf    : integer;
+    Bm             : TBufBookmark;
+  begin
+    with AUpdBuffer do if assigned(BookmarkData.BookmarkData) then // this is used to exclude buffers which are already handled
+      begin
+      if (UpdateKind = ukModify) then
+        begin
+        FCurrentIndex.GotoBookmark(@BookmarkData);
+        move(pchar(OldValuesBuffer)^,pchar(FCurrentIndex.CurrentBuffer)^,FRecordSize);
+        FreeRecordBuffer(OldValuesBuffer);
+        end
+      else if (UpdateKind = ukDelete) and (assigned(OldValuesBuffer)) then
+        begin
+        FCurrentIndex.GotoBookmark(@BookmarkData);
+        FCurrentIndex.InsertRecordBeforeCurrentRecord(IntAllocRecordBuffer);
+        FCurrentIndex.ScrollBackward;
+        move(pchar(OldValuesBuffer)^,pchar(FCurrentIndex.CurrentBuffer)^,FRecordSize);
+        FreeRecordBuffer(OldValuesBuffer);
+        inc(FBRecordCount);
+        end
+      else if (UpdateKind = ukInsert) then
+        begin
+        // Process all upd-buffers linked to this record before this record is removed
+        StoreUpdBuf:=FCurrentUpdateBuffer;
+        Bm := BookmarkData;
+        BookmarkData.BookmarkData:=nil; // Avoid infinite recursion...
+        if GetRecordUpdateBuffer(Bm,True,False) then
+          begin
+          repeat
+          if (FCurrentUpdateBuffer<>StoreUpdBuf) then CancelUpdBuffer(FUpdateBuffer[FCurrentUpdateBuffer]);
+          until not GetRecordUpdateBuffer(Bm,True,True);
+          end;
+        FCurrentUpdateBuffer:=StoreUpdBuf;
+
+        FCurrentIndex.GotoBookmark(@Bm);
+        TmpBuf:=FCurrentIndex.CurrentRecord;
+        // resync won't work if the currentbuffer is freed...
+        if FCurrentIndex.CompareBookmarks(@Bm,@StoreRecBM) then with FCurrentIndex do
+          begin
+          GotoBookmark(@StoreRecBM);
+          if ScrollForward = grEOF then
+            ScrollBackward;
+          StoreCurrentRecIntoBookmark(@StoreRecBM);
+          end;
+        FCurrentIndex.RemoveRecordFromIndex(Bm);
+        FreeRecordBuffer(TmpBuf);
+        dec(FBRecordCount);
+        end;
+      BookmarkData.BookmarkData:=nil;
+      end;
+  end;
 
 var r              : Integer;
-    StoreRecBM     : TBufBookmark;
-    TmpBuf         : PChar;
 
 begin
   CheckBrowseMode;
@@ -1792,41 +1794,9 @@ begin
     begin
     FCurrentIndex.StoreCurrentRecIntoBookmark(@StoreRecBM);
     r := Length(FUpdateBuffer) -1;
-    while r > -1 do with FUpdateBuffer[r] do
+    while r > -1 do
       begin
-        begin
-        if UpdateKind = ukModify then
-          begin
-          FCurrentIndex.GotoBookmark(@BookmarkData);
-          move(pchar(OldValuesBuffer)^,pchar(FCurrentIndex.CurrentBuffer)^,FRecordSize);
-          FreeRecordBuffer(OldValuesBuffer);
-          end
-        else if (UpdateKind = ukDelete) and (assigned(FUpdateBuffer[r].OldValuesBuffer)) then
-          begin
-          FCurrentIndex.GotoBookmark(@BookmarkData);
-          FCurrentIndex.InsertRecordBeforeCurrentRecord(IntAllocRecordBuffer);
-          FCurrentIndex.ScrollBackward;
-          move(pchar(OldValuesBuffer)^,pchar(FCurrentIndex.CurrentBuffer)^,FRecordSize);
-          FreeRecordBuffer(OldValuesBuffer);
-          inc(FBRecordCount);
-          end
-        else if UpdateKind = ukInsert then
-          begin
-          FCurrentIndex.GotoBookmark(@BookmarkData);
-          TmpBuf:=FCurrentIndex.CurrentRecord;
-          // resync won't work if the currentbuffer is freed...
-          if FCurrentIndex.CompareBookmarks(@BookmarkData,@StoreRecBM) then with FCurrentIndex do
-            begin
-            GotoBookmark(@StoreRecBM);
-            if ScrollForward = grEOF then
-              ScrollBackward;
-            StoreCurrentRecIntoBookmark(@StoreRecBM);
-            end;
-          FCurrentIndex.RemoveRecordFromIndex(BookmarkData);
-          FreeRecordBuffer(TmpBuf);
-          dec(FBRecordCount);
-          end;
-        end;
+      CancelUpdBuffer(FUpdateBuffer[r]);
       dec(r)
       end;
 
@@ -1871,7 +1841,8 @@ begin
     while (r < Length(FUpdateBuffer)) and (Response <> rrAbort) do
       begin
       // If the record is first inserted and afterwards deleted, do nothing
-      if (FUpdateBuffer[r].UpdateKind=ukDelete) and (assigned(FUpdateBuffer[r].OldValuesBuffer)) then
+      if not ((FUpdateBuffer[r].UpdateKind=ukDelete) and not (assigned(FUpdateBuffer[r].OldValuesBuffer))) then
+      if not (FUpdateBuffer[r].UpdateKind=ukDelete) then
         begin
         FCurrentIndex.GotoBookmark(@FUpdateBuffer[r].BookmarkData);
         // Joost: I do not see the use of this resync?
@@ -1932,7 +1903,7 @@ begin
       SetLength(FUpdateBlobBuffers,0);
       end;
 
-    GotoBookmark(@StoreCurrRec);
+    InternalGotoBookmark(@StoreCurrRec);
     Resync([]);
     EnableControls;
   end;
@@ -2036,48 +2007,6 @@ begin
     end;
 
   move(ActiveBuffer^,FCurrentIndex.CurrentBuffer^,FRecordSize);
-//  CurrBuff:=pchar(tmpRecBuffer);
-// The next part has to be rewritten.
-{
-  CurrBuff := FCurrentIndex.CurrentBuffer;
-  if FCurrentIndex=FIndexes[1] then StartInd := 1 else StartInd := 2;
-  for i := StartInd to FIndexesCount-1 do
-    begin
-    IndNr:=(FIndexes[i] as TDoubleLinkedBufIndex).IndNr;
-    if (assigned(PBufRecLinkItem(CurrBuff)[IndNr].prior)) and
-       (IndexCompareRecords(CurrBuff,PBufRecLinkItem(CurrBuff)[IndNr].prior,FIndexes[i].DBCompareStruct) < 0) then
-      begin
-      // Remove record from index
-      RemoveRecordFromIndex(PBufRecLinkItem(CurrBuff),FIndexes[i]);
-      // iterate to new position
-      tmpRecBuffer:=PBufRecLinkItem(CurrBuff)[IndNr].prior;
-      while assigned(tmpRecBuffer[IndNr].prior) and
-           (IndexCompareRecords(CurrBuff,tmpRecBuffer[indnr].prior,FIndexes[i].DBCompareStruct) < 0) do
-        begin
-        tmpRecBuffer:=tmpRecBuffer[IndNr].prior;
-        end;
-      // Place record at new position
-      AddRecordToIndex(PBufRecLinkItem(CurrBuff),tmpRecBuffer,FIndexes[i]);
-      end
-    else if (PBufRecLinkItem(CurrBuff)[IndNr].next <> (FIndexes[i] as TDoubleLinkedBufIndex).FLastRecBuf) and
-            (IndexCompareRecords(CurrBuff,PBufRecLinkItem(CurrBuff)[(FIndexes[i] as TDoubleLinkedBufIndex).IndNr].next,FIndexes[i].DBCompareStruct) > 0) then
-      begin
-      // Remove record from index
-      RemoveRecordFromIndex(PBufRecLinkItem(CurrBuff),FIndexes[i]);
-      // iterate to new position
-      tmpRecBuffer:=PBufRecLinkItem(CurrBuff)[IndNr].next;
-      while (tmpRecBuffer<>(FIndexes[i] as TDoubleLinkedBufIndex).FLastRecBuf) and
-           (IndexCompareRecords(CurrBuff,tmpRecBuffer[indnr].next,FIndexes[i].DBCompareStruct) > 0) do
-        begin
-        tmpRecBuffer:=tmpRecBuffer[IndNr].next;
-        end;
-      // The record should be added _after_ the the current record, not before
-      if (tmpRecBuffer<>(FIndexes[i] as TDoubleLinkedBufIndex).FLastRecBuf) then
-        tmpRecBuffer:=tmpRecBuffer[IndNr].next;
-      // Place record at new position
-      AddRecordToIndex(PBufRecLinkItem(CurrBuff),tmpRecBuffer,FIndexes[i]);
-      end;
-    end;}
 end;
 
 procedure TBufDataset.CalcRecordSize;
@@ -2499,6 +2428,11 @@ begin
   CreateFields;
 end;
 
+function TBufDataset.BookmarkValid(ABookmark: TBookmark): Boolean;
+begin
+  Result:=FCurrentIndex.BookmarkValid(ABookmark);
+end;
+
 function TBufDataset.CompareBookmarks(Bookmark1, Bookmark2: TBookmark
   ): Longint;
 begin
@@ -2793,6 +2727,7 @@ begin
 
   // Set The filter-buffer
   StoreDSState:=State;
+  FFilterBuffer:=FCurrentIndex.SpareBuffer;
   SetTempState(dsFilter);
   SetFieldValues(keyfields,KeyValues);
   CurrLinkItem := (FCurrentIndex as TDoubleLinkedBufIndex).FFirstRecBuf;

packages/fcl-db/src/base/dataset.inc

@@ -504,6 +504,31 @@ begin
   Result:=nil;
 end;
 
+function TDataSet.GetRecordSize: Word;
+begin
+  Result := 0;
+end;
+
+procedure TDataSet.InternalAddRecord(Buffer: Pointer; AAppend: Boolean);
+begin
+  // empty stub
+end;
+
+procedure TDataSet.InternalDelete;
+begin
+  // empty stub
+end;
+
+procedure TDataSet.InternalFirst;
+begin
+  // empty stub
+end;
+
+procedure TDataSet.InternalGotoBookmark(ABookmark: Pointer);
+begin
+  // empty stub
+end;
+
 function TDataSet.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
 
 begin
@@ -512,10 +537,27 @@ end;
 
 procedure TDataSet.DataConvert(aField: TField; aSource, aDest: Pointer;
   aToNative: Boolean);
-  
+
+ // There seems to be no WStrCopy defined, this is a copy of
+ // the generic StrCopy function, adapted for WideChar.
+ Function WStrCopy(Dest, Source:PWideChar): PWideChar;
+ var
+   counter : SizeInt;
+ Begin
+   counter := 0;
+   while Source[counter] <> #0 do
+   begin
+     Dest[counter] := char(Source[counter]);
+     Inc(counter);
+   end;
+   { terminate the string }
+   Dest[counter] := #0;
+   WStrCopy := Dest;
+ end;
+
 var
   DT : TFieldType;
-  
+
 begin
   DT := aField.DataType;
   if aToNative then
@@ -525,11 +567,10 @@ begin
       ftTimeStamp               : TTimeStamp(aDest^) := TTimeStamp(aSource^);
       ftBCD                     : TBCD(aDest^) := CurrToBCD(Currency(aSource^));
       ftFMTBCD                  : TBcd(aDest^) := TBcd(aSource^);
-  // See notes from mantis bug-report 7204 for more information
+  // See notes from mantis bug-report 8204 for more information
   //    ftBytes                   : ;
   //    ftVarBytes                : ;
-  //    ftWideString              : ;
-
+      ftWideString              : WStrCopy(PWideChar(aDest), PWideChar(aSource));
       end
     end
   else
@@ -541,8 +582,7 @@ begin
       ftFMTBCD                  : TBcd(aDest^) := TBcd(aSource^);
   //    ftBytes                   : ;
   //    ftVarBytes                : ;
-  //    ftWideString              : ;
-
+      ftWideString              : WStrCopy(PWideChar(aDest), PWideChar(aSource));
       end
     end
 end;
@@ -840,21 +880,7 @@ begin
     Insert;
 
   for i := 0 to ValuesSize-1 do with values[i] do
-    case VType of
-      vtInteger   : fields[i].AsInteger    := VInteger;
-      vtBoolean   : fields[i].AsBoolean    := VBoolean;
-      vtChar      : fields[i].AsString     := VChar;
-      vtWideChar  : fields[i].AsString     := VWideChar;
-      vtString    : fields[i].AsString     := AnsiString(VString);
-      vtAnsiString: fields[i].AsString     := AnsiString(VAnsiString);
-      vtCurrency  : fields[i].AsCurrency   := VCurrency^;
-//      vtWideString: fields[i].AsWideString := VWideString;
-      vtInt64     : fields[i].AsLargeInt   := VInt64^;
-      vtQWord     : fields[i].AsLargeInt   := VQWord^;
-      vtVariant   : fields[i].AsVariant    := VVariant^;
-    else
-      DatabaseError(SIncompatibleTVarRec);
-    end; {case}
+    fields[i].AssignValue(values[i]);
   Post;
 
 end;
@@ -973,6 +999,16 @@ begin
     ShowException(ExceptObject,ExceptAddr);
 end;
 
+procedure TDataSet.InternalInitRecord(Buffer: PChar);
+begin
+  // empty stub
+end;
+
+procedure TDataSet.InternalLast;
+begin
+  // empty stub
+end;
+
 procedure TDataSet.InternalPost;
 
   Procedure Checkrequired;
@@ -992,6 +1028,21 @@ begin
   Checkrequired;
 end;
 
+procedure TDataSet.InternalSetToRecord(Buffer: PChar);
+begin
+  // empty stub
+end;
+
+procedure TDataSet.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
+begin
+  // empty stub
+end;
+
+procedure TDataSet.SetBookmarkData(Buffer: PChar; Data: Pointer);
+begin
+  // empty stub
+end;
+
 procedure TDataSet.SetUniDirectional(const Value: Boolean);
 begin
   FIsUniDirectional := Value;
@@ -1322,6 +1373,26 @@ begin
   // Empty Abstract
 end;
 
+function TDataSet.AllocRecordBuffer: PChar;
+begin
+  Result := nil;
+end;
+
+procedure TDataSet.FreeRecordBuffer(var Buffer: PChar);
+begin
+  // empty stub
+end;
+
+procedure TDataSet.GetBookmarkData(Buffer: PChar; Data: Pointer);
+begin
+  // empty stub
+end;
+
+function TDataSet.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
+begin
+  Result := bfCurrent;
+end;
+
 Function TDataset.ControlsDisabled: Boolean;
 
 begin
@@ -2222,6 +2293,7 @@ end;
 Function TDataset.Lookup(const KeyFields: string; const KeyValues: Variant; const ResultFields: string): Variant;
 
 begin
+  CheckBiDirectional;
   Result := False;
 end;
 

packages/fcl-db/src/base/datasource.inc

@@ -453,7 +453,7 @@ begin
       begin
       If Assigned(DS) then
         F:=DS.FindField(FParams[i].Name);
-      If (Not Assigned(DS)) or (F<>Nil) then
+      If (Not Assigned(DS)) or (not DS.Active) or (F<>Nil) then
         begin
         If (FN<>'') then
           FN:=FN+';';

packages/fcl-db/src/base/db.pas

@@ -173,18 +173,18 @@ type
     FInternalCalcField : Boolean;
     FPrecision : Longint;
     FRequired : Boolean;
-    FSize : Word;
+    FSize : Integer;
     FAttributes : TFieldAttributes;
     Function GetFieldClass : TFieldClass;
     procedure SetAttributes(AValue: TFieldAttributes);
     procedure SetDataType(AValue: TFieldType);
     procedure SetPrecision(const AValue: Longint);
-    procedure SetSize(const AValue: Word);
+    procedure SetSize(const AValue: Integer);
     procedure SetRequired(const AValue: Boolean);
   public
     constructor create(ACollection : TCollection); overload;
     constructor Create(AOwner: TFieldDefs; const AName: string;
-      ADataType: TFieldType; ASize: Word; ARequired: Boolean; AFieldNo: Longint); overload;
+      ADataType: TFieldType; ASize: Integer; ARequired: Boolean; AFieldNo: Longint); overload;
     destructor Destroy; override;
     procedure Assign(APersistent: TPersistent); override;
     function CreateField(AOwner: TComponent): TField;
@@ -196,7 +196,7 @@ type
     property Attributes: TFieldAttributes read FAttributes write SetAttributes default [];
     property DataType: TFieldType read FDataType write SetDataType;
     property Precision: Longint read FPrecision write SetPrecision;
-    property Size: Word read FSize write SetSize;
+    property Size: Integer read FSize write SetSize;
   end;
 
 { TFieldDefs }
@@ -290,7 +290,7 @@ type
     FOrigin : String;
     FReadOnly : Boolean;
     FRequired : Boolean;
-    FSize : Word;
+    FSize : integer;
     FValidChars : TFieldChars;
     FValueBuffer : Pointer;
     FValidating : Boolean;
@@ -333,7 +333,7 @@ type
     function GetAsWideString: WideString; virtual;
     function GetCanModify: Boolean; virtual;
     function GetClassDesc: String; virtual;
-    function GetDataSize: Word; virtual;
+    function GetDataSize: Integer; virtual;
     function GetDefaultWidth: Longint; virtual;
     function GetDisplayName : String;
     function GetCurValue: Variant; virtual;
@@ -359,7 +359,7 @@ type
     procedure SetDataset(AValue : TDataset); virtual;
     procedure SetDataType(AValue: TFieldType);
     procedure SetNewValue(const AValue: Variant);
-    procedure SetSize(AValue: Word); virtual;
+    procedure SetSize(AValue: Integer); virtual;
     procedure SetParentComponent(AParent: TComponent); override;
     procedure SetText(const AValue: string); virtual;
     procedure SetVarValue(const AValue: Variant); virtual;
@@ -395,7 +395,7 @@ type
     property CanModify: Boolean read GetCanModify;
     property CurValue: Variant read GetCurValue;
     property DataSet: TDataSet read FDataSet write SetDataSet;
-    property DataSize: Word read GetDataSize;
+    property DataSize: Integer read GetDataSize;
     property DataType: TFieldType read FDataType;
     property DisplayName: String Read GetDisplayName;
     property DisplayText: String read GetDisplayText;
@@ -404,7 +404,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 SetSize;
+    property Size: Integer read FSize write SetSize;
     property Text: string read GetEditText write SetEditText;
     property ValidChars : TFieldChars Read FValidChars;
     property Value: variant read GetAsVariant write SetAsVariant;
@@ -453,7 +453,7 @@ type
     function GetAsLongint: Longint; override;
     function GetAsString: string; override;
     function GetAsVariant: variant; override;
-    function GetDataSize: Word; override;
+    function GetDataSize: Integer; override;
     function GetDefaultWidth: Longint; override;
     procedure GetText(var AText: string; ADisplayText: Boolean); override;
     function GetValue(var AValue: string): Boolean;
@@ -489,7 +489,7 @@ type
     function GetAsWideString: WideString; override;
     procedure SetAsWideString(const aValue: WideString); override;
 
-    function GetDataSize: Word; override;
+    function GetDataSize: Integer; override;
   public
     constructor Create(aOwner: TComponent); override;
     property Value: WideString read GetAsWideString write SetAsWideString;
@@ -530,7 +530,7 @@ type
     function GetAsLongint: Longint; override;
     function GetAsString: string; override;
     function GetAsVariant: variant; override;
-    function GetDataSize: Word; override;
+    function GetDataSize: Integer; override;
     procedure GetText(var AText: string; ADisplayText: Boolean); override;
     function GetValue(var AValue: Longint): Boolean;
     procedure SetAsFloat(AValue: Double); override;
@@ -563,7 +563,7 @@ type
     function GetAsLargeint: Largeint; override;
     function GetAsString: string; override;
     function GetAsVariant: variant; override;
-    function GetDataSize: Word; override;
+    function GetDataSize: Integer; override;
     procedure GetText(var AText: string; ADisplayText: Boolean); override;
     function GetValue(var AValue: Largeint): Boolean;
     procedure SetAsFloat(AValue: Double); override;
@@ -584,7 +584,7 @@ type
 
   TSmallintField = class(TLongintField)
   protected
-    function GetDataSize: Word; override;
+    function GetDataSize: Integer; override;
   public
     constructor Create(AOwner: TComponent); override;
   end;
@@ -593,7 +593,7 @@ type
 
   TWordField = class(TLongintField)
   protected
-    function GetDataSize: Word; override;
+    function GetDataSize: Integer; override;
   public
     constructor Create(AOwner: TComponent); override;
   end;
@@ -621,7 +621,7 @@ type
     function GetAsLongint: Longint; override;
     function GetAsVariant: variant; override;
     function GetAsString: string; override;
-    function GetDataSize: Word; override;
+    function GetDataSize: Integer; override;
     procedure GetText(var theText: string; ADisplayText: Boolean); override;
     procedure SetAsFloat(AValue: Double); override;
     procedure SetAsLongint(AValue: Longint); override;
@@ -660,7 +660,7 @@ type
     function GetAsBoolean: Boolean; override;
     function GetAsString: string; override;
     function GetAsVariant: variant; override;
-    function GetDataSize: Word; override;
+    function GetDataSize: Integer; override;
     function GetDefaultWidth: Longint; override;
     procedure SetAsBoolean(AValue: Boolean); override;
     procedure SetAsString(const AValue: string); override;
@@ -683,7 +683,7 @@ type
     function GetAsFloat: Double; override;
     function GetAsString: string; override;
     function GetAsVariant: variant; override;
-    function GetDataSize: Word; override;
+    function GetDataSize: Integer; override;
     procedure GetText(var theText: string; ADisplayText: Boolean); override;
     procedure SetAsDateTime(AValue: TDateTime); override;
     procedure SetAsFloat(AValue: Double); override;
@@ -732,7 +732,7 @@ type
 
   TBytesField = class(TBinaryField)
   protected
-    function GetDataSize: Word; override;
+    function GetDataSize: Integer; override;
   public
     constructor Create(AOwner: TComponent); override;
   end;
@@ -741,7 +741,7 @@ type
 
   TVarBytesField = class(TBytesField)
   protected
-    function GetDataSize: Word; override;
+    function GetDataSize: Integer; override;
   public
     constructor Create(AOwner: TComponent); override;
   end;
@@ -762,7 +762,7 @@ type
     function GetAsString: string; override;
     function GetValue(var AValue: Currency): Boolean;
     function GetAsVariant: variant; override;
-    function GetDataSize: Word; override;
+    function GetDataSize: Integer; override;
     function GetDefaultWidth: Longint; override;
     procedure GetText(var TheText: string; ADisplayText: Boolean); override;
     procedure SetAsFloat(AValue: Double); override;
@@ -794,7 +794,6 @@ type
     FTransliterate : Boolean;
     Function GetBlobStream (Mode : TBlobStreamMode) : TStream;
   protected
-    procedure AssignTo(Dest: TPersistent); override;
     procedure FreeBuffers; override;
     function GetAsString: string; override;
     function GetAsVariant: Variant; override;
@@ -808,7 +807,6 @@ type
     procedure SetAsWideString(const aValue: WideString); override;
   public
     constructor Create(AOwner: TComponent); override;
-    procedure Assign(Source: TPersistent); override;
     procedure Clear; override;
     class function IsBlob: Boolean; override;
     procedure LoadFromFile(const FileName: string);
@@ -1235,30 +1233,30 @@ type
     property CalcFieldsSize: Longint read FCalcFieldsSize;
     property InternalCalcFields: Boolean read FInternalCalcFields;
     property Constraints: TCheckConstraints read FConstraints write FConstraints;
-  protected { abstract methods }
-    function AllocRecordBuffer: PChar; virtual; abstract;
-    procedure FreeRecordBuffer(var Buffer: PChar); virtual; abstract;
-    procedure GetBookmarkData(Buffer: PChar; Data: Pointer); virtual; abstract;
-    function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; virtual; abstract;
+    function AllocRecordBuffer: PChar; virtual;
+    procedure FreeRecordBuffer(var Buffer: PChar); virtual;
+    procedure GetBookmarkData(Buffer: PChar; Data: Pointer); virtual;
+    function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; virtual;
     function GetDataSource: TDataSource; virtual;
+    function GetRecordSize: Word; virtual;
+    procedure InternalAddRecord(Buffer: Pointer; AAppend: Boolean); virtual;
+    procedure InternalDelete; virtual;
+    procedure InternalFirst; virtual;
+    procedure InternalGotoBookmark(ABookmark: Pointer); virtual;
+    procedure InternalHandleException; virtual;
+    procedure InternalInitRecord(Buffer: PChar); virtual;
+    procedure InternalLast; virtual;
+    procedure InternalPost; virtual;
+    procedure InternalSetToRecord(Buffer: PChar); virtual;
+    procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); virtual;
+    procedure SetBookmarkData(Buffer: PChar; Data: Pointer); virtual;
+    procedure SetUniDirectional(const Value: Boolean);
+  protected { abstract methods }
     function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; virtual; abstract;
-    function GetRecordSize: Word; virtual; abstract;
-    procedure InternalAddRecord(Buffer: Pointer; AAppend: Boolean); virtual; abstract;
     procedure InternalClose; virtual; abstract;
-    procedure InternalDelete; virtual; abstract;
-    procedure InternalFirst; virtual; abstract;
-    procedure InternalGotoBookmark(ABookmark: Pointer); virtual; abstract;
-    procedure InternalHandleException; virtual;
-    procedure InternalInitFieldDefs; virtual; abstract;
-    procedure InternalInitRecord(Buffer: PChar); virtual; abstract;
-    procedure InternalLast; virtual; abstract;
     procedure InternalOpen; virtual; abstract;
-    procedure InternalPost; virtual;
-    procedure InternalSetToRecord(Buffer: PChar); virtual; abstract;
+    procedure InternalInitFieldDefs; virtual; abstract;
     function IsCursorOpen: Boolean; virtual; abstract;
-    procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); virtual; abstract;
-    procedure SetBookmarkData(Buffer: PChar; Data: Pointer); virtual; abstract;
-    procedure SetUniDirectional(const Value: Boolean);
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;

packages/fcl-db/src/base/dbconst.pas

@@ -44,7 +44,6 @@ Resourcestring
   STransNotActive          = 'Operation cannot be performed on an inactive transaction';
   STransActive             = 'Operation cannot be performed on an active transaction';
   SFieldNotFound           = 'Field not found : "%s"';
-  SIncompatibleTVarRec     = 'Faild to assign one of the TVarRec values into a TField';
   SInactiveDataset         = 'Operation cannot be performed on an inactive dataset';
   SInvalidDisplayValues    = '"%s" are not valid boolean displayvalues';
   SInvalidFieldKind        = '%s : invalid field kind : ';

packages/fcl-db/src/base/dsparams.inc

@@ -1,4 +1,27 @@
 
+procedure SkipQuotesString(var p : pchar; QuoteChar : char; EscapeSlash, EscapeRepeat : Boolean);
+var notRepeatEscaped : boolean;
+begin
+  Inc(p);
+  repeat
+    notRepeatEscaped := True;
+    while not (p^ in [#0, QuoteChar]) do
+    begin
+      if EscapeSlash and (p^='\') and (p[1] <> #0) then Inc(p,2) // make sure we handle \' and \\ correct
+      else Inc(p);
+    end;
+    if p^=QuoteChar then
+    begin
+      Inc(p); // skip final '
+      if (p^=QuoteChar) and EscapeRepeat then // Handle escaping by ''
+      begin
+      notRepeatEscaped := False;
+      inc(p);
+      end
+    end;
+  until notRepeatEscaped;
+end;
+
 { TParams }
 
 Function TParams.GetItem(Index: Integer): TParam;
@@ -177,36 +200,20 @@ begin
 end;
 
 function SkipComments(var p: PChar; EscapeSlash, EscapeRepeat : Boolean) : Boolean;
-var notRepeatEscaped : boolean;
 
-  procedure SkipQuotesString(QuoteChar : char);
-  begin
-    Inc(p);
-    Result := True;
-    repeat
-      notRepeatEscaped := True;
-      while not (p^ in [#0, QuoteChar]) do
+begin
+  result := false;
+  case p^ of
+    '''':
       begin
-        if EscapeSlash and (p^='\') and (p[1] <> #0) then Inc(p,2) // make sure we handle \' and \\ correct
-        else Inc(p);
+        SkipQuotesString(p,'''',EscapeSlash,EscapeRepeat); // single quote delimited string
+        Result := True;
       end;
-      if p^=QuoteChar then
+    '"':
       begin
-        Inc(p); // skip final '
-        if (p^=QuoteChar) and EscapeRepeat then // Handle escaping by ''
-        begin
-        notRepeatEscaped := False;
-        inc(p);
-        end
+        SkipQuotesString(p,'"',EscapeSlash,EscapeRepeat);  // double quote delimited string
+        Result := True;
       end;
-    until notRepeatEscaped;
-  end;
-
-begin
-  result := false;
-  case p^ of
-    '''': SkipQuotesString('''');       // single quote delimited string
-    '"':  SkipQuotesString('"');        // double quote delimited string
     '-': // possible start of -- comment
       begin
         Inc(p);
@@ -295,10 +302,21 @@ begin
             end
             else
             begin
-              ParamNameStart:=p;
-              while not (p^ in (SQLDelimiterCharacters+[#0,'=','+','-','*','\','/','[',']','|'])) do
-                Inc(p);
-              ParamName:=Copy(ParamNameStart,1,p-ParamNameStart);
+              if p^='"' then // Check if the parameter-name is between quotes
+                begin
+                ParamNameStart:=p;
+                SkipQuotesString(p,'"',EscapeSlash,EscapeRepeat);
+                // Do not include the quotes in ParamName, but they must be included
+                // when the parameter is replaced by some place-holder.
+                ParamName:=Copy(ParamNameStart+1,1,p-ParamNameStart-2);
+                end
+              else
+                begin
+                ParamNameStart:=p;
+                while not (p^ in (SQLDelimiterCharacters+[#0,'=','+','-','*','\','/','[',']','|'])) do
+                  Inc(p);
+                ParamName:=Copy(ParamNameStart,1,p-ParamNameStart);
+                end;
             end;
           end
           else

packages/fcl-db/src/base/fields.inc

@@ -36,7 +36,7 @@ begin
 end;
 
 Constructor TFieldDef.Create(AOwner: TFieldDefs; const AName: string;
-      ADataType: TFieldType; ASize: Word; ARequired: Boolean; AFieldNo: Longint);
+      ADataType: TFieldType; ASize: Integer; ARequired: Boolean; AFieldNo: Longint);
 
 begin
 {$ifdef dsdebug }
@@ -138,7 +138,7 @@ begin
   Changed(False);
 end;
 
-procedure TFieldDef.SetSize(const AValue: Word);
+procedure TFieldDef.SetSize(const AValue: Integer);
 begin
   FSize := AValue;
   Changed(False);
@@ -369,7 +369,7 @@ begin
       vtWideString:
         AsWideString := WideString(VWideString);
       vtInt64:
-        Self.Value := VInt64^;
+        AsLargeInt := VInt64^;
     else
       Error;
     end;
@@ -564,7 +564,7 @@ begin
     Result:=FDataset.GetFieldData(Self,Buffer,NativeFormat);
 end;
 
-function TField.GetDataSize: Word;
+function TField.GetDataSize: Integer;
 
 begin
   Result:=0;
@@ -860,7 +860,7 @@ begin
     DataSet := AParent as TDataSet;
 end;
 
-procedure TField.SetSize(AValue: Word);
+procedure TField.SetSize(AValue: Integer);
 
 begin
   CheckInactive;
@@ -1058,7 +1058,7 @@ begin
 end;
 
 
-function TStringField.GetDataSize: Word;
+function TStringField.GetDataSize: Integer;
 
 begin
   Result:=Size+1;
@@ -1179,12 +1179,12 @@ var
   Buffer    : PWideChar;
 begin
   if DataSize <= dsMaxStringSize then begin
-    Result := GetData(@FixBuffer, True);
+    Result := GetData(@FixBuffer, False);
     aValue := FixBuffer;
   end else begin
     SetLength(DynBuffer, Succ(Size));
     Buffer := PWideChar(DynBuffer);
-    Result := GetData(Buffer, True);
+    Result := GetData(Buffer, False);
     if Result then
       aValue := Buffer;
   end;
@@ -1234,7 +1234,7 @@ begin
   SetData(Buffer, False);
 end;
 
-function TWideStringField.GetDataSize: Word;
+function TWideStringField.GetDataSize: Integer;
 begin
   Result :=
     (Size + 1) * 2;
@@ -1343,7 +1343,7 @@ begin
     Result:='';
 end;
 
-function TLongintField.GetDataSize: Word;
+function TLongintField.GetDataSize: Integer;
 
 begin
   Result:=SizeOf(Longint);
@@ -1513,7 +1513,7 @@ begin
     Result:='';
 end;
 
-function TLargeintField.GetDataSize: Word;
+function TLargeintField.GetDataSize: Integer;
 
 begin
   Result:=SizeOf(Largeint);
@@ -1632,7 +1632,7 @@ end;
 
 { TSmallintField }
 
-function TSmallintField.GetDataSize: Word;
+function TSmallintField.GetDataSize: Integer;
 
 begin
   Result:=SizeOf(SmallInt);
@@ -1650,7 +1650,7 @@ end;
 
 { TWordField }
 
-function TWordField.GetDataSize: Word;
+function TWordField.GetDataSize: Integer;
 
 begin
   Result:=SizeOf(Word);
@@ -1725,7 +1725,7 @@ begin
     Result:='';
 end;
 
-function TFloatField.GetDataSize: Word;
+function TFloatField.GetDataSize: Integer;
 
 begin
   Result:=SizeOf(Double);
@@ -1865,7 +1865,7 @@ begin
     result:='';
 end;
 
-function TBooleanField.GetDataSize: Word;
+function TBooleanField.GetDataSize: Integer;
 
 begin
   Result:=SizeOf(wordBool);
@@ -1984,7 +1984,7 @@ begin
 end;
 
 
-function TDateTimeField.GetDataSize: Word;
+function TDateTimeField.GetDataSize: Integer;
 
 begin
   Result:=SizeOf(TDateTime);
@@ -2145,7 +2145,7 @@ end;
 
 { TBytesField }
 
-function TBytesField.GetDataSize: Word;
+function TBytesField.GetDataSize: Integer;
 
 begin
   Result:=Size;
@@ -2164,7 +2164,7 @@ end;
 
 { TVarBytesField }
 
-function TVarBytesField.GetDataSize: Word;
+function TVarBytesField.GetDataSize: Integer;
 
 begin
   Result:=Size+2;
@@ -2237,7 +2237,7 @@ begin
   Result := GetData(@AValue);
 end;
 
-function TBCDField.GetDataSize: Word;
+function TBCDField.GetDataSize: Integer;
 
 begin
   result := sizeof(system.currency);
@@ -2330,13 +2330,6 @@ end;
 
 { TBlobField }
 
-
-procedure TBlobField.AssignTo(Dest: TPersistent);
-
-begin
-  //!! To be implemented
-end;
-
 Function TBlobField.GetBlobStream(Mode : TBlobStreamMode) : TStream;
 
 begin
@@ -2492,13 +2485,6 @@ begin
 end;
 
 
-procedure TBlobField.Assign(Source: TPersistent);
-
-begin
-  //!! To be implemented
-end;
-
-
 procedure TBlobField.Clear;
 
 begin

packages/fcl-db/src/sqldb/odbc/odbcconn.pas

@@ -130,7 +130,7 @@ type
     property OnLogin;
   end;
 
-  EODBCException = class(Exception)
+  EODBCException = class(EDatabaseError)
     // currently empty; perhaps we can add fields here later that describe the error instead of one simple message string
   end;
 

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

@@ -16,6 +16,11 @@ uses
   oratypes;
 
 type
+  EOraDatabaseError = class(EDatabaseError)
+    public
+      ORAErrorCode : Longint;
+  end;
+
   TOracleTrans = Class(TSQLHandle)
     protected
   end;
@@ -92,10 +97,18 @@ procedure TOracleConnection.HandleError;
 
 var errcode : sb4;
     buf     : array[0..1023] of char;
+    E       : EOraDatabaseError;
 
 begin
-  OCIErrorGet(FOciError,1,nil,errcode,@buf[1],1023,OCI_HTYPE_ERROR);
-  DatabaseErrorFmt(SErrOracle+LineEnding+buf,[inttostr(errcode)],self);
+  OCIErrorGet(FOciError,1,nil,errcode,@buf[0],1024,OCI_HTYPE_ERROR);
+
+  if (Self.Name <> '') then
+    E := EOraDatabaseError.CreateFmt('%s : %s',[Self.Name,buf])
+  else
+    E := EOraDatabaseError.Create(buf);
+
+  E.ORAErrorCode := errcode;
+  Raise E;
 end;
 
 procedure TOracleConnection.DoInternalConnect;
@@ -156,7 +169,7 @@ var tel : word;
 begin
   with cursor as TOracleCursor do
     begin
-    OCIHandleFree(FOciStmt,OCI_HTYPE_ERROR);
+    OCIHandleFree(FOciStmt,OCI_HTYPE_STMT);
     if Length(FieldBuffers) > 0 then
       for tel := 0 to high(FieldBuffers) do freemem(FieldBuffers[tel].buffer);
     end;

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

@@ -298,7 +298,7 @@ type
     property DeleteSQL : TStringlist read FDeleteSQL;
     property Params : TParams read FParams write FParams;
     property UpdateMode : TUpdateMode read FUpdateMode write SetUpdateMode;
-    property UsePrimaryKeyAsKey : boolean read FUsePrimaryKeyAsKey write SetUsePrimaryKeyAsKey;
+    property UsePrimaryKeyAsKey : boolean read FUsePrimaryKeyAsKey write SetUsePrimaryKeyAsKey default true;
     property StatementType : TStatementType read GetStatementType;
     property ParseSQL : Boolean read FParseSQL write SetParseSQL default true;
     Property DataSource : TDatasource Read GetDataSource Write SetDatasource;
@@ -1366,7 +1366,7 @@ var FieldNamesQuoteChar : char;
     if (pfInKey in Fields[x].ProviderFlags) or
        ((FUpdateMode = upWhereAll) and (pfInWhere in Fields[x].ProviderFlags)) or
        ((FUpdateMode = UpWhereChanged) and (pfInWhere in Fields[x].ProviderFlags) and (fields[x].value <> fields[x].oldvalue)) then
-      sql_where := sql_where + '(' + FieldNamesQuoteChar + fields[x].FieldName + FieldNamesQuoteChar + '= :OLD_' + fields[x].FieldName + ') and ';
+      sql_where := sql_where + '(' + FieldNamesQuoteChar + fields[x].FieldName + FieldNamesQuoteChar + '= :' + FieldNamesQuoteChar + 'OLD_' + fields[x].FieldName + FieldNamesQuoteChar +') and ';
   end;
 
   function ModifyRecQuery : string;
@@ -1383,7 +1383,7 @@ var FieldNamesQuoteChar : char;
       UpdateWherePart(sql_where,x);
 
       if (pfInUpdate in Fields[x].ProviderFlags) then
-        sql_set := sql_set +FieldNamesQuoteChar + fields[x].FieldName + FieldNamesQuoteChar +'=:' + fields[x].FieldName + ',';
+        sql_set := sql_set +FieldNamesQuoteChar + fields[x].FieldName + FieldNamesQuoteChar +'=:' + FieldNamesQuoteChar + fields[x].FieldName + FieldNamesQuoteChar + ',';
       end;
 
     if length(sql_set) = 0 then DatabaseErrorFmt(sNoUpdateFields,['update'],self);
@@ -1408,7 +1408,7 @@ var FieldNamesQuoteChar : char;
       if (not fields[x].IsNull) and (pfInUpdate in Fields[x].ProviderFlags) then
         begin
         sql_fields := sql_fields + FieldNamesQuoteChar + fields[x].FieldName + FieldNamesQuoteChar + ',';
-        sql_values := sql_values + ':' + fields[x].FieldName + ',';
+        sql_values := sql_values + ':' + FieldNamesQuoteChar + fields[x].FieldName + FieldNamesQuoteChar +',';
         end;
       end;
     if length(sql_fields) = 0 then DatabaseErrorFmt(sNoUpdateFields,['insert'],self);

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

@@ -170,10 +170,7 @@ begin
         ftsmallint: checkerror(sqlite3_bind_int(fstatement,I,p.asinteger));
         ftword:     checkerror(sqlite3_bind_int(fstatement,I,P.asword));
         ftlargeint: checkerror(sqlite3_bind_int64(fstatement,I,P.aslargeint));
-        ftbcd: begin
-               cu1:= P.ascurrency;
-               checkerror(sqlite3_bind_int64(fstatement,I,pint64(@cu1)^));
-               end;
+        ftbcd,
         ftfloat,
         ftcurrency,
         ftdatetime,
@@ -391,7 +388,7 @@ begin
                 end;
       ftUnknown : DatabaseError('Unknown record type: '+FN);
     end; // Case
-    tfielddef.create(fielddefs,FN,ft1,size1,false,i+1);
+    tfielddef.create(fielddefs,FieldDefs.MakeNameUnique(FN),ft1,size1,false,i+1);
     end;
 end;
 
@@ -482,7 +479,7 @@ var
  str1: string;
  ar1,ar2: TStringArray;
  st    : psqlite3_stmt;
- 
+
 begin
   st:=TSQLite3Cursor(cursor).fstatement;
   fnum:= FieldDef.fieldno - 1;
@@ -496,8 +493,8 @@ begin
     ftSmallInt : psmallint(buffer)^ := sqlite3_column_int(st,fnum);
     ftWord     : pword(buffer)^     := sqlite3_column_int(st,fnum);
     ftBoolean  : pwordbool(buffer)^ := sqlite3_column_int(st,fnum)<>0;
-    ftLargeInt,
-    ftBCD      : PInt64(buffer)^:= sqlite3_column_int64(st,fnum);
+    ftLargeInt : PInt64(buffer)^:= sqlite3_column_int64(st,fnum);
+    ftBCD      : PCurrency(buffer)^:= FloattoCurr(sqlite3_column_double(st,fnum));
     ftFloat,
     ftCurrency : pdouble(buffer)^:= sqlite3_column_double(st,fnum);
     ftDateTime,

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

@@ -1,4 +1,4 @@
-unit sqlite3ds;
+unit Sqlite3DS;
 
 {
   This is TSqlite3Dataset, a TDataset descendant class for use with fpc compiler
@@ -33,36 +33,36 @@ unit sqlite3ds;
 
 {$mode objfpc}
 {$H+}
-{ $Define DEBUG}
+{.$Define DEBUG_SQLITEDS}
 
 interface
 
 uses
-  Classes, SysUtils, customsqliteds;
+  Classes, SysUtils, CustomSqliteDS;
 
 type
   { TSqlite3Dataset }
 
-  TSqlite3Dataset = class (TCustomSqliteDataset)
+  TSqlite3Dataset = class(TCustomSqliteDataset)
   private
-    function SqliteExec(ASql:PChar; ACallback: TSqliteCdeclCallback; Data: Pointer):Integer;override;
+    function SqliteExec(ASQL: PChar; ACallback: TSqliteCdeclCallback; Data: Pointer): Integer; override;
     function InternalGetHandle: Pointer; override;
     function GetSqliteVersion: String; override;
-    procedure InternalCloseHandle;override;
+    procedure InternalCloseHandle; override;
     procedure BuildLinkedList; override;
   protected
     procedure InternalInitFieldDefs; override;
     function GetRowsAffected:Integer; override;
   public
-    procedure ExecuteDirect(const ASql: String);override;
+    procedure ExecuteDirect(const ASQL: String); override;
     function ReturnString: String; override;
-    function QuickQuery(const ASql:String;const AStrList: TStrings;FillObjects:Boolean):String;override;
+    function QuickQuery(const ASQL: String; const AStrList: TStrings; FillObjects: Boolean): String; override;
   end;
 
 implementation
 
 uses
-  sqlite3,db;
+  sqlite3, db;
   
 function SqliteCode2Str(Code: Integer): String;
 begin
@@ -97,11 +97,11 @@ begin
     SQLITE_NOTADB       : Result := 'SQLITE_NOTADB';
     SQLITE_DONE         : Result := 'SQLITE_DONE';
   else
-    Result:='Unknown Return Value';
+    Result := 'Unknown Return Value';
   end;
 end;
 
-function GetAutoIncValue(NextValue: Pointer; Columns: Integer; ColumnValues: PPChar; ColumnNames: PPChar): integer; cdecl;
+function GetAutoIncValue(NextValue: Pointer; Columns: Integer; ColumnValues: PPChar; ColumnNames: PPChar): Integer; cdecl;
 var
   CodeError, TempInt: Integer;
 begin
@@ -118,15 +118,15 @@ end;
 
 { TSqlite3Dataset }
 
-function TSqlite3Dataset.SqliteExec(ASql: PChar; ACallback: TSqliteCdeclCallback; Data: Pointer): Integer;
+function TSqlite3Dataset.SqliteExec(ASQL: PChar; ACallback: TSqliteCdeclCallback; Data: Pointer): Integer;
 begin
-  Result:=sqlite3_exec(FSqliteHandle, ASql, ACallback, Data, nil);
+  Result := sqlite3_exec(FSqliteHandle, ASQL, ACallback, Data, nil);
 end;
 
 procedure TSqlite3Dataset.InternalCloseHandle;
 begin
   sqlite3_close(FSqliteHandle);
-  FSqliteHandle:=nil;
+  FSqliteHandle := nil;
   //todo:handle return data
 end;
 
@@ -144,7 +144,7 @@ begin
   FReturnCode := sqlite3_prepare(Result, CheckFileSql, -1, @vm, nil);
   if FReturnCode <> SQLITE_OK then
   begin
-    ErrorStr := SqliteCode2Str(FReturnCode) + ' - ' + sqlite3_errmsg(Result);;
+    ErrorStr := SqliteCode2Str(FReturnCode) + ' - ' + sqlite3_errmsg(Result);
     sqlite3_close(Result);
     DatabaseError(ErrorStr, Self);
   end;
@@ -160,12 +160,12 @@ var
   i, ColumnCount: Integer;
   AType: TFieldType;
 begin
-  {$ifdef DEBUG}
+  {$ifdef DEBUG_SQLITEDS}
   WriteLn('##TSqlite3Dataset.InternalInitFieldDefs##');
   {$endif}
   FAutoIncFieldNo := -1;
   FieldDefs.Clear;
-  FReturnCode := sqlite3_prepare(FSqliteHandle, PChar(FSql), -1, @vm, nil);
+  FReturnCode := sqlite3_prepare(FSqliteHandle, PChar(FSQL), -1, @vm, nil);
   if FReturnCode <> SQLITE_OK then
     DatabaseError(ReturnString, Self);
   sqlite3_step(vm);
@@ -176,145 +176,145 @@ begin
   SetLength(FGetSqlStr, ColumnCount);
   for i := 0 to ColumnCount - 1 do
   begin
-   ColumnStr := UpperCase(String(sqlite3_column_decltype(vm, i)));
-   if (ColumnStr = 'INTEGER') or (ColumnStr = 'INT') then
-   begin
-     if AutoIncrementKey and (UpperCase(String(sqlite3_column_name(vm, i))) = UpperCase(PrimaryKey)) then
-     begin
-       AType := ftAutoInc;
-       FAutoIncFieldNo := i;
-     end
-     else
-       AType := ftInteger;     
-   end else if Pos('VARCHAR', ColumnStr) = 1 then
-   begin
-     AType := ftString;
-   end else if Pos('BOOL', ColumnStr) = 1 then
-   begin
-     AType := ftBoolean;
-   end else if Pos('AUTOINC', ColumnStr) = 1 then
-   begin
-     AType := ftAutoInc;
-     if FAutoIncFieldNo = -1 then
-       FAutoIncFieldNo := i;
-   end else if (Pos('FLOAT', ColumnStr) = 1) or (Pos('NUMERIC', ColumnStr) = 1) then
-   begin
-     AType := ftFloat;
-   end else if (ColumnStr = 'DATETIME') then
-   begin
-     AType := ftDateTime;
-   end else if (ColumnStr = 'DATE') then
-   begin
-     AType := ftDate;
-   end else if (ColumnStr = 'LARGEINT') then
-   begin
-     AType := ftLargeInt;
-   end else if (ColumnStr = 'TIME') then
-   begin
-     AType := ftTime;
-   end else if (ColumnStr = 'TEXT') then
-   begin
-     AType := ftMemo;
-   end else if (ColumnStr = 'CURRENCY') then
-   begin
-     AType := ftCurrency;
-   end else if (ColumnStr = 'WORD') then
-   begin
-     AType := ftWord;
-   end else if (ColumnStr = '') then
-   begin
-     case sqlite3_column_type(vm, i) of
-       SQLITE_INTEGER:
-         AType := ftInteger;
-       SQLITE_FLOAT:
-         AType := ftFloat;
-     else
-       AType := ftString;
-     end;
-   end else
-   begin
-     AType := ftString;
-   end;
-   FieldDefs.Add(String(sqlite3_column_name(vm, i)), AType, FieldSizeMap[AType = ftString]);
-   //Set the pchar2sql function
-   if AType in [ftString, ftMemo] then
-     FGetSqlStr[i] := @Char2SqlStr
-   else
-     FGetSqlStr[i] := @Num2SqlStr;
-   {$ifdef DEBUG}
-   writeln('  Field[',i,'] Name: ', sqlite3_column_name(vm,i));
-   writeln('  Field[',i,'] Type: ', sqlite3_column_decltype(vm,i));
-   {$endif}
+    ColumnStr := UpperCase(String(sqlite3_column_decltype(vm, i)));
+    if (ColumnStr = 'INTEGER') or (ColumnStr = 'INT') then
+    begin
+      if AutoIncrementKey and (UpperCase(String(sqlite3_column_name(vm, i))) = UpperCase(PrimaryKey)) then
+      begin
+        AType := ftAutoInc;
+        FAutoIncFieldNo := i;
+      end
+      else
+        AType := ftInteger;
+    end else if Pos('VARCHAR', ColumnStr) = 1 then
+    begin
+      AType := ftString;
+    end else if Pos('BOOL', ColumnStr) = 1 then
+    begin
+      AType := ftBoolean;
+    end else if Pos('AUTOINC', ColumnStr) = 1 then
+    begin
+      AType := ftAutoInc;
+      if FAutoIncFieldNo = -1 then
+        FAutoIncFieldNo := i;
+    end else if (Pos('FLOAT', ColumnStr) = 1) or (Pos('NUMERIC', ColumnStr) = 1) then
+    begin
+      AType := ftFloat;
+    end else if (ColumnStr = 'DATETIME') then
+    begin
+      AType := ftDateTime;
+    end else if (ColumnStr = 'DATE') then
+    begin
+      AType := ftDate;
+    end else if (ColumnStr = 'LARGEINT') then
+    begin
+      AType := ftLargeInt;
+    end else if (ColumnStr = 'TIME') then
+    begin
+      AType := ftTime;
+    end else if (ColumnStr = 'TEXT') then
+    begin
+      AType := ftMemo;
+    end else if (ColumnStr = 'CURRENCY') then
+    begin
+      AType := ftCurrency;
+    end else if (ColumnStr = 'WORD') then
+    begin
+      AType := ftWord;
+    end else if (ColumnStr = '') then
+    begin
+      case sqlite3_column_type(vm, i) of
+        SQLITE_INTEGER:
+          AType := ftInteger;
+        SQLITE_FLOAT:
+          AType := ftFloat;
+      else
+        AType := ftString;
+      end;
+    end else
+    begin
+      AType := ftString;
+    end;
+    FieldDefs.Add(String(sqlite3_column_name(vm, i)), AType, FieldSizeMap[AType = ftString]);
+    //Set the pchar2sql function
+    if AType in [ftString, ftMemo] then
+      FGetSqlStr[i] := @Char2SQLStr
+    else
+      FGetSqlStr[i] := @Num2SQLStr;
+    {$ifdef DEBUG_SQLITEDS}
+    WriteLn('  Field[', i, '] Name: ', sqlite3_column_name(vm, i));
+    WriteLn('  Field[', i, '] Type: ', sqlite3_column_decltype(vm, i));
+    {$endif}
   end;
   sqlite3_finalize(vm);
-  {$ifdef DEBUG}
-  writeln('  FieldDefs.Count: ', FieldDefs.Count);
+  {$ifdef DEBUG_SQLITEDS}
+  WriteLn('  FieldDefs.Count: ', FieldDefs.Count);
   {$endif}
 end;
 
 function TSqlite3Dataset.GetRowsAffected: Integer;
 begin
-  Result:=sqlite3_changes(FSqliteHandle);
+  Result := sqlite3_changes(FSqliteHandle);
 end;
 
-procedure TSqlite3Dataset.ExecuteDirect(const ASql: String);
+procedure TSqlite3Dataset.ExecuteDirect(const ASQL: String);
 var
-  vm:Pointer;
+  vm: Pointer;
 begin
-  FReturnCode:=sqlite3_prepare(FSqliteHandle,Pchar(ASql),-1,@vm,nil);
+  FReturnCode := sqlite3_prepare(FSqliteHandle, Pchar(ASQL), -1, @vm, nil);
   if FReturnCode <> SQLITE_OK then
-    DatabaseError(ReturnString,Self);
-  FReturnCode:=sqlite3_step(vm);
+    DatabaseError(ReturnString, Self);
+  FReturnCode := sqlite3_step(vm);
   sqlite3_finalize(vm);
 end;
 
 procedure TSqlite3Dataset.BuildLinkedList;
 var
-  TempItem:PDataRecord;
-  vm:Pointer;
-  Counter:Integer;
+  TempItem: PDataRecord;
+  vm: Pointer;
+  Counter: Integer;
 begin
   //Get AutoInc Field initial value
   if FAutoIncFieldNo <> -1 then
-    sqlite3_exec(FSqliteHandle,PChar('Select Max('+Fields[FAutoIncFieldNo].FieldName+') from ' + FTableName),
-      @GetAutoIncValue,@FNextAutoInc,nil);
+    sqlite3_exec(FSqliteHandle, PChar('Select Max(' + Fields[FAutoIncFieldNo].FieldName +
+      ') from ' + FTableName), @GetAutoIncValue, @FNextAutoInc, nil);
 
-  FReturnCode:=sqlite3_prepare(FSqliteHandle,Pchar(FSql),-1,@vm,nil);
+  FReturnCode := sqlite3_prepare(FSqliteHandle, PChar(FSQL), -1, @vm, nil);
   if FReturnCode <> SQLITE_OK then
-    DatabaseError(ReturnString,Self);
+    DatabaseError(ReturnString, Self);
 
-  FDataAllocated:=True;
+  FDataAllocated := True;
 
-  TempItem:=FBeginItem;
-  FRecordCount:=0;
-  FRowCount:=sqlite3_column_count(vm);
-  FReturnCode:=sqlite3_step(vm);
+  TempItem := FBeginItem;
+  FRecordCount := 0;
+  FRowCount := sqlite3_column_count(vm);
+  FReturnCode := sqlite3_step(vm);
   while FReturnCode = SQLITE_ROW do
   begin
     Inc(FRecordCount);
     New(TempItem^.Next);
-    TempItem^.Next^.Previous:=TempItem;
-    TempItem:=TempItem^.Next;
-    GetMem(TempItem^.Row,FRowBufferSize);
+    TempItem^.Next^.Previous := TempItem;
+    TempItem := TempItem^.Next;
+    GetMem(TempItem^.Row, FRowBufferSize);
     for Counter := 0 to FRowCount - 1 do
-      TempItem^.Row[Counter]:=StrNew(sqlite3_column_text(vm,Counter));
-    FReturnCode:=sqlite3_step(vm);
+      TempItem^.Row[Counter] := StrNew(sqlite3_column_text(vm, Counter));
+    FReturnCode := sqlite3_step(vm);
   end;
   sqlite3_finalize(vm);
 
   // Attach EndItem
-  TempItem^.Next:=FEndItem;
-  FEndItem^.Previous:=TempItem;
+  TempItem^.Next := FEndItem;
+  FEndItem^.Previous := TempItem;
 
   // Alloc temporary item used in append/insert
-  GetMem(FCacheItem^.Row,FRowBufferSize);
+  GetMem(FCacheItem^.Row, FRowBufferSize);
   for Counter := 0 to FRowCount - 1 do
-    FCacheItem^.Row[Counter]:=nil;
+    FCacheItem^.Row[Counter] := nil;
   // Fill FBeginItem.Row with nil -> necessary for avoid exceptions in empty datasets
-  GetMem(FBeginItem^.Row,FRowBufferSize);
+  GetMem(FBeginItem^.Row, FRowBufferSize);
   //Todo: see if is better to nullif using FillDWord
   for Counter := 0 to FRowCount - 1 do
-    FBeginItem^.Row[Counter]:=nil;
+    FBeginItem^.Row[Counter] := nil;
 end;
 
 function TSqlite3Dataset.ReturnString: String;
@@ -327,9 +327,9 @@ begin
   Result := String(sqlite3_version());
 end;
 
-function TSqlite3Dataset.QuickQuery(const ASql:String;const AStrList: TStrings;FillObjects:Boolean):String;
+function TSqlite3Dataset.QuickQuery(const ASQL: String; const AStrList: TStrings; FillObjects:Boolean): String;
 var
-  vm:Pointer;
+  vm: Pointer;
     
   procedure FillStrings;
   begin
@@ -343,7 +343,8 @@ var
   begin
     while FReturnCode = SQLITE_ROW do
     begin
-      AStrList.AddObject(String(sqlite3_column_text(vm,0)), TObject(PtrInt(sqlite3_column_int(vm,1))));
+      AStrList.AddObject(String(sqlite3_column_text(vm, 0)),
+        TObject(PtrInt(sqlite3_column_int(vm, 1))));
       FReturnCode := sqlite3_step(vm);
     end;
   end;    
@@ -351,14 +352,14 @@ begin
   if FSqliteHandle = nil then
     GetSqliteHandle;
   Result := '';
-  FReturnCode := sqlite3_prepare(FSqliteHandle,Pchar(ASql), -1, @vm, nil);
+  FReturnCode := sqlite3_prepare(FSqliteHandle,Pchar(ASQL), -1, @vm, nil);
   if FReturnCode <> SQLITE_OK then
-    DatabaseError(ReturnString,Self);
+    DatabaseError(ReturnString, Self);
     
   FReturnCode := sqlite3_step(vm);
   if (FReturnCode = SQLITE_ROW) and (sqlite3_column_count(vm) > 0) then
   begin
-    Result := String(sqlite3_column_text(vm,0));
+    Result := String(sqlite3_column_text(vm, 0));
     if AStrList <> nil then
     begin   
       if FillObjects and (sqlite3_column_count(vm) > 1) then

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

@@ -1,4 +1,4 @@
-unit sqliteds;
+unit SqliteDS;
 
 {
   This is TSqliteDataset, a TDataset descendant class for use with fpc compiler
@@ -33,42 +33,42 @@ unit sqliteds;
 
 {$mode objfpc}
 {$H+}
-{ $Define DEBUG}
+{.$Define DEBUG_SQLITEDS}
 
 interface
 
 uses
-  Classes, SysUtils, customsqliteds;
+  Classes, SysUtils, CustomSqliteDS;
 
 type
   { TSqliteDataset }
 
-  TSqliteDataset = class (TCustomSqliteDataset)
+  TSqliteDataset = class(TCustomSqliteDataset)
   private
-    function SqliteExec(ASql:PChar; ACallback: TSqliteCdeclCallback; Data: Pointer):Integer;override;
+    function SqliteExec(ASQL: PChar; ACallback: TSqliteCdeclCallback; Data: Pointer): Integer; override;
     function InternalGetHandle: Pointer; override;
     function GetSqliteEncoding: String;
     function GetSqliteVersion: String; override;
-    procedure InternalCloseHandle;override;
+    procedure InternalCloseHandle; override;
     procedure BuildLinkedList; override;
   protected
     procedure InternalInitFieldDefs; override;
     function GetRowsAffected:Integer; override;
   public
-    procedure ExecuteDirect(const ASql: String);override;
+    procedure ExecuteDirect(const ASQL: String); override;
     function ReturnString: String; override;
-    function QuickQuery(const ASql:String;const AStrList: TStrings;FillObjects:Boolean):String;override;
+    function QuickQuery(const ASQL: String; const AStrList: TStrings; FillObjects: Boolean): String; override;
     property SqliteEncoding: String read GetSqliteEncoding;
   end;
 
 implementation
 
 uses
-  sqlite,db;
+  sqlite, db;
 
 //function sqlite_last_statement_changes(dbhandle:Pointer):longint;cdecl;external 'sqlite' name 'sqlite_last_statement_changes';
 
-function GetAutoIncValue(NextValue: Pointer; Columns: Integer; ColumnValues: PPChar; ColumnNames: PPChar): integer; cdecl;
+function GetAutoIncValue(NextValue: Pointer; Columns: Integer; ColumnValues: PPChar; ColumnNames: PPChar): Integer; cdecl;
 var
   CodeError, TempInt: Integer;
 begin
@@ -85,15 +85,15 @@ end;
 
 { TSqliteDataset }
 
-function TSqliteDataset.SqliteExec(ASql: PChar; ACallback: TSqliteCdeclCallback; Data: Pointer): Integer;
+function TSqliteDataset.SqliteExec(ASQL: PChar; ACallback: TSqliteCdeclCallback; Data: Pointer): Integer;
 begin
-  Result:=sqlite_exec(FSqliteHandle, ASql, ACallback, Data, nil);
+  Result := sqlite_exec(FSqliteHandle, ASQL, ACallback, Data, nil);
 end;
 
 procedure TSqliteDataset.InternalCloseHandle;
 begin
   sqlite_close(FSqliteHandle);
-  FSqliteHandle:=nil;
+  FSqliteHandle := nil;
 end;
 
 function TSqliteDataset.InternalGetHandle: Pointer;
@@ -103,29 +103,29 @@ begin
   Result := sqlite_open(PChar(FFileName), 0, @ErrorStr);
   if Result = nil then
   begin
-    DatabaseError('Error opening "' + FFileName +'": ' + String(ErrorStr));
+    DatabaseError('Error opening "' + FFileName + '": ' + String(ErrorStr));
     sqlite_freemem(ErrorStr);
   end;
 end;
 
 procedure TSqliteDataset.InternalInitFieldDefs;
 var
-  ColumnCount,i:Integer;
-  AType:TFieldType;
-  vm:Pointer;
-  ColumnNames,ColumnValues:PPChar;
-  ColumnStr:String;
+  ColumnCount, i:Integer;
+  AType: TFieldType;
+  vm: Pointer;
+  ColumnNames, ColumnValues:PPChar;
+  ColumnStr: String;
 begin
   FieldDefs.Clear;
   FAutoIncFieldNo := -1;
-  FReturnCode := sqlite_compile(FSqliteHandle,PChar(FSql),nil,@vm,nil);
+  FReturnCode := sqlite_compile(FSqliteHandle, PChar(FSQL), nil, @vm, nil);
   if FReturnCode <> SQLITE_OK then
     DatabaseError(ReturnString, Self);
-  sqlite_step(vm,@ColumnCount,@ColumnValues,@ColumnNames);
+  sqlite_step(vm, @ColumnCount, @ColumnValues, @ColumnNames);
   //Prepare the array of pchar2sql functions
-  SetLength(FGetSqlStr,ColumnCount);
+  SetLength(FGetSqlStr, ColumnCount);
   //Set BufferSize
-  FRowBufferSize:=(SizeOf(PPChar)*ColumnCount);
+  FRowBufferSize := (SizeOf(PPChar) * ColumnCount);
   // Sqlite is typeless (allows any type in any field)
   // regardless of what is in Create Table, but returns
   // exactly what is in Create Table statement
@@ -144,18 +144,18 @@ begin
       end
       else
         AType := ftInteger;
-    end else if Pos('VARCHAR',ColumnStr) = 1 then
+    end else if Pos('VARCHAR', ColumnStr) = 1 then
     begin
       AType := ftString;
-    end else if Pos('BOOL',ColumnStr) = 1 then
+    end else if Pos('BOOL', ColumnStr) = 1 then
     begin
       AType := ftBoolean;
-    end else if Pos('AUTOINC',ColumnStr) = 1 then
+    end else if Pos('AUTOINC', ColumnStr) = 1 then
     begin
       AType := ftAutoInc;
       if FAutoIncFieldNo = -1 then
         FAutoIncFieldNo := i;
-    end else if (Pos('FLOAT',ColumnStr)=1) or (Pos('NUMERIC',ColumnStr)=1) then
+    end else if (Pos('FLOAT', ColumnStr)=1) or (Pos('NUMERIC', ColumnStr) = 1) then
     begin
       AType := ftFloat;
     end else if (ColumnStr = 'DATETIME') then
@@ -188,10 +188,10 @@ begin
     else
       FieldDefs.Add(String(ColumnNames[i]), AType);  
     //Set the pchar2sql function
-    if AType in [ftString,ftMemo] then
-      FGetSqlStr[i]:=@Char2SqlStr
+    if AType in [ftString, ftMemo] then
+      FGetSqlStr[i] := @Char2SQLStr
     else
-      FGetSqlStr[i]:=@Num2SqlStr;
+      FGetSqlStr[i] := @Num2SQLStr;
   end;
   sqlite_finalize(vm, nil);
   {
@@ -202,108 +202,116 @@ end;
 
 function TSqliteDataset.GetRowsAffected: Integer;
 begin
-  Result:=sqlite_changes(FSqliteHandle);
-  //Result:=sqlite_last_statement_changes(FSqliteHandle);
+  Result := sqlite_changes(FSqliteHandle);
+  //Result := sqlite_last_statement_changes(FSqliteHandle);
 end;
 
-procedure TSqliteDataset.ExecuteDirect(const ASql: String);
+procedure TSqliteDataset.ExecuteDirect(const ASQL: String);
 var
-  vm:Pointer;
-  ColumnNames,ColumnValues:PPChar;
-  ColCount:Integer;
+  vm: Pointer;
+  ColumnNames, ColumnValues: PPChar;
+  ColCount: Integer;
 begin
-  FReturnCode:=sqlite_compile(FSqliteHandle,Pchar(ASql),nil,@vm,nil);
+  FReturnCode := sqlite_compile(FSqliteHandle, Pchar(ASQL), nil, @vm, nil);
   if FReturnCode <> SQLITE_OK then
     DatabaseError(ReturnString,Self);
 
-  FReturnCode:=sqlite_step(vm,@ColCount,@ColumnValues,@ColumnNames);
+  FReturnCode := sqlite_step(vm, @ColCount, @ColumnValues, @ColumnNames);
 
   sqlite_finalize(vm, nil);
 end;
 
 procedure TSqliteDataset.BuildLinkedList;
 var
-  TempItem:PDataRecord;
-  vm:Pointer;
-  ColumnNames,ColumnValues:PPChar;
-  Counter:Integer;
+  TempItem: PDataRecord;
+  vm: Pointer;
+  ColumnNames, ColumnValues: PPChar;
+  Counter: Integer;
 begin
   //Get AutoInc Field initial value
   if FAutoIncFieldNo <> -1 then
-    sqlite_exec(FSqliteHandle,PChar('Select Max('+Fields[FAutoIncFieldNo].FieldName+') from ' + FTableName),
-      @GetAutoIncValue,@FNextAutoInc,nil);
+    sqlite_exec(FSqliteHandle, PChar('Select Max(' + Fields[FAutoIncFieldNo].FieldName + ') from ' + FTableName),
+      @GetAutoIncValue, @FNextAutoInc, nil);
 
-  FReturnCode:=sqlite_compile(FSqliteHandle,Pchar(FSql),nil,@vm,nil);
+  FReturnCode := sqlite_compile(FSqliteHandle, PChar(FSQL), nil, @vm, nil);
   if FReturnCode <> SQLITE_OK then
-    DatabaseError(ReturnString,Self);
+    DatabaseError(ReturnString, Self);
 
-  FDataAllocated:=True;
+  FDataAllocated := True;
 
-  TempItem:=FBeginItem;
-  FRecordCount:=0;
-  FReturnCode:=sqlite_step(vm,@FRowCount,@ColumnValues,@ColumnNames);
+  TempItem := FBeginItem;
+  FRecordCount := 0;
+  FReturnCode := sqlite_step(vm, @FRowCount, @ColumnValues, @ColumnNames);
   while FReturnCode = SQLITE_ROW do
   begin
     Inc(FRecordCount);
     New(TempItem^.Next);
-    TempItem^.Next^.Previous:=TempItem;
-    TempItem:=TempItem^.Next;
-    GetMem(TempItem^.Row,FRowBufferSize);
+    TempItem^.Next^.Previous := TempItem;
+    TempItem := TempItem^.Next;
+    GetMem(TempItem^.Row, FRowBufferSize);
     for Counter := 0 to FRowCount - 1 do
-      TempItem^.Row[Counter]:=StrNew(ColumnValues[Counter]);
-    FReturnCode:=sqlite_step(vm,@FRowCount,@ColumnValues,@ColumnNames);
+      TempItem^.Row[Counter] := StrNew(ColumnValues[Counter]);
+    FReturnCode := sqlite_step(vm, @FRowCount, @ColumnValues, @ColumnNames);
   end;
   sqlite_finalize(vm, nil);
 
   // Attach EndItem
-  TempItem^.Next:=FEndItem;
-  FEndItem^.Previous:=TempItem;
+  TempItem^.Next := FEndItem;
+  FEndItem^.Previous := TempItem;
 
   // Alloc item used in append/insert
-  GetMem(FCacheItem^.Row,FRowBufferSize);
+  GetMem(FCacheItem^.Row, FRowBufferSize);
   for Counter := 0 to FRowCount - 1 do
-    FCacheItem^.Row[Counter]:=nil;
+    FCacheItem^.Row[Counter] := nil;
   // Fill FBeginItem.Row with nil -> necessary for avoid exceptions in empty datasets
-  GetMem(FBeginItem^.Row,FRowBufferSize);
+  GetMem(FBeginItem^.Row, FRowBufferSize);
   for Counter := 0 to FRowCount - 1 do
-    FBeginItem^.Row[Counter]:=nil;
+    FBeginItem^.Row[Counter] := nil;
 end;
 
 function TSqliteDataset.ReturnString: String;
 begin
- case FReturnCode of
-      SQLITE_OK           : Result := 'SQLITE_OK';
-      SQLITE_ERROR        : Result := 'SQLITE_ERROR';
-      SQLITE_INTERNAL     : Result := 'SQLITE_INTERNAL';
-      SQLITE_PERM         : Result := 'SQLITE_PERM';
-      SQLITE_ABORT        : Result := 'SQLITE_ABORT';
-      SQLITE_BUSY         : Result := 'SQLITE_BUSY';
-      SQLITE_LOCKED       : Result := 'SQLITE_LOCKED';
-      SQLITE_NOMEM        : Result := 'SQLITE_NOMEM';
-      SQLITE_READONLY     : Result := 'SQLITE_READONLY';
-      SQLITE_INTERRUPT    : Result := 'SQLITE_INTERRUPT';
-      SQLITE_IOERR        : Result := 'SQLITE_IOERR';
-      SQLITE_CORRUPT      : Result := 'SQLITE_CORRUPT';
-      SQLITE_NOTFOUND     : Result := 'SQLITE_NOTFOUND';
-      SQLITE_FULL         : Result := 'SQLITE_FULL';
-      SQLITE_CANTOPEN     : Result := 'SQLITE_CANTOPEN';
-      SQLITE_PROTOCOL     : Result := 'SQLITE_PROTOCOL';
-      SQLITE_EMPTY        : Result := 'SQLITE_EMPTY';
-      SQLITE_SCHEMA       : Result := 'SQLITE_SCHEMA';
-      SQLITE_TOOBIG       : Result := 'SQLITE_TOOBIG';
-      SQLITE_CONSTRAINT   : Result := 'SQLITE_CONSTRAINT';
-      SQLITE_MISMATCH     : Result := 'SQLITE_MISMATCH';
-      SQLITE_MISUSE       : Result := 'SQLITE_MISUSE';
-      SQLITE_NOLFS        : Result := 'SQLITE_NOLFS';
-      SQLITE_AUTH         : Result := 'SQLITE_AUTH';
-      SQLITE_FORMAT       : Result := 'SQLITE_FORMAT';
-      SQLITE_RANGE        : Result := 'SQLITE_RANGE';
-      SQLITE_ROW          : begin Result := 'SQLITE_ROW - not an error'; Exit; end;
-      SQLITE_DONE         : begin Result := 'SQLITE_DONE - not an error'; Exit; end;
+  case FReturnCode of
+    SQLITE_OK           : Result := 'SQLITE_OK';
+    SQLITE_ERROR        : Result := 'SQLITE_ERROR';
+    SQLITE_INTERNAL     : Result := 'SQLITE_INTERNAL';
+    SQLITE_PERM         : Result := 'SQLITE_PERM';
+    SQLITE_ABORT        : Result := 'SQLITE_ABORT';
+    SQLITE_BUSY         : Result := 'SQLITE_BUSY';
+    SQLITE_LOCKED       : Result := 'SQLITE_LOCKED';
+    SQLITE_NOMEM        : Result := 'SQLITE_NOMEM';
+    SQLITE_READONLY     : Result := 'SQLITE_READONLY';
+    SQLITE_INTERRUPT    : Result := 'SQLITE_INTERRUPT';
+    SQLITE_IOERR        : Result := 'SQLITE_IOERR';
+    SQLITE_CORRUPT      : Result := 'SQLITE_CORRUPT';
+    SQLITE_NOTFOUND     : Result := 'SQLITE_NOTFOUND';
+    SQLITE_FULL         : Result := 'SQLITE_FULL';
+    SQLITE_CANTOPEN     : Result := 'SQLITE_CANTOPEN';
+    SQLITE_PROTOCOL     : Result := 'SQLITE_PROTOCOL';
+    SQLITE_EMPTY        : Result := 'SQLITE_EMPTY';
+    SQLITE_SCHEMA       : Result := 'SQLITE_SCHEMA';
+    SQLITE_TOOBIG       : Result := 'SQLITE_TOOBIG';
+    SQLITE_CONSTRAINT   : Result := 'SQLITE_CONSTRAINT';
+    SQLITE_MISMATCH     : Result := 'SQLITE_MISMATCH';
+    SQLITE_MISUSE       : Result := 'SQLITE_MISUSE';
+    SQLITE_NOLFS        : Result := 'SQLITE_NOLFS';
+    SQLITE_AUTH         : Result := 'SQLITE_AUTH';
+    SQLITE_FORMAT       : Result := 'SQLITE_FORMAT';
+    SQLITE_RANGE        : Result := 'SQLITE_RANGE';
+    SQLITE_ROW          :
+      begin
+        Result := 'SQLITE_ROW - not an error';
+        Exit;
+      end;
+    SQLITE_DONE         :
+      begin
+        Result := 'SQLITE_DONE - not an error';
+        Exit;
+      end;
   else
-    Result:='Unknow Return Value';
- end;
- Result:=Result+' - '+sqlite_error_string(FReturnCode);
+    Result := 'Unknow Return Value';
+  end;
+  Result := Result + ' - ' + sqlite_error_string(FReturnCode);
 end;
 
 function TSqliteDataset.GetSqliteEncoding: String;
@@ -316,7 +324,7 @@ begin
   Result := String(sqlite_version);
 end;
 
-function TSqliteDataset.QuickQuery(const ASql:String;const AStrList: TStrings;FillObjects:Boolean):String;
+function TSqliteDataset.QuickQuery(const ASQL: String; const AStrList: TStrings; FillObjects: Boolean): String;
 var
   vm: Pointer;
   ColumnNames, ColumnValues: PPChar;
@@ -335,15 +343,16 @@ var
     while FReturnCode = SQLITE_ROW do
     begin
       // I know, this code is really dirty!!
-      AStrList.AddObject(String(ColumnValues[0]), TObject(PtrInt(StrToInt(String(ColumnValues[1])))));
-      FReturnCode:=sqlite_step(vm, @ColCount, @ColumnValues, @ColumnNames);
+      AStrList.AddObject(String(ColumnValues[0]),
+        TObject(PtrInt(StrToInt(String(ColumnValues[1])))));
+      FReturnCode := sqlite_step(vm, @ColCount, @ColumnValues, @ColumnNames);
     end;
   end;    
 begin
   if FSqliteHandle = nil then
     GetSqliteHandle;
   Result := '';
-  FReturnCode := sqlite_compile(FSqliteHandle, PChar(ASql), nil, @vm, nil);
+  FReturnCode := sqlite_compile(FSqliteHandle, PChar(ASQL), nil, @vm, nil);
   if FReturnCode <> SQLITE_OK then
     DatabaseError(ReturnString,Self);
     

packages/fcl-db/tests/database.ini.txt

@@ -76,6 +76,10 @@ user=root
 password=
 hostname=127.0.0.1
 
+[sqlite]
+connector=sql
+connectorparams=sqlite3
+name=test.db
 
 ; This section is for a connector for TDbf:
 [dbf]

packages/fcl-db/tests/dbtestframework.pas

@@ -11,9 +11,17 @@ uses
   fpcunit,  testreport, testregistry,
   DigestTestReport,
   toolsunit,
+// List of supported database-connectors
+  sqldbtoolsunit,
+  dbftoolsunit,
+  memdstoolsunit,
+  SdfDSToolsUnit,
 // Units wich contains the tests
-  testbasics, testfieldtypes, TestDatasources, testdbbasics;
-  
+  testbasics,
+  testfieldtypes,
+  TestDatasources,
+  testdbbasics;
+
 var
   FXMLResultsWriter: TXMLResultsWriter;
   FDigestResultsWriter: TDigestResultsWriter;

packages/fcl-db/tests/sqldbtoolsunit.pas

@@ -77,6 +77,7 @@ type
     procedure DropFieldDataset; override;
     Function InternalGetNDataset(n : integer) : TDataset; override;
     Function InternalGetFieldDataset : TDataSet; override;
+    procedure TryDropIfExist(ATableName : String);
   public
     destructor Destroy; override;
     constructor Create; override;
@@ -171,6 +172,7 @@ var CountID : Integer;
 begin
   try
     Ftransaction.StartTransaction;
+    TryDropIfExist('FPDEV');
     Fconnection.ExecuteDirect('create table FPDEV (       ' +
                               '  ID INT NOT NULL,           ' +
                               '  NAME VARCHAR(50),          ' +
@@ -196,6 +198,7 @@ var CountID : Integer;
 begin
   try
     Ftransaction.StartTransaction;
+    TryDropIfExist('FPDEV_FIELD');
 
     Sql := 'create table FPDEV_FIELD (ID INT NOT NULL,';
     for FType := low(TFieldType)to high(TFieldType) do
@@ -283,6 +286,24 @@ begin
     end;
 end;
 
+procedure TSQLDBConnector.TryDropIfExist(ATableName: String);
+begin
+  // This makes live soo much easier, since it avoids the exception if the table already
+  // exists. And while this exeption is in a try..except statement, the debugger
+  // always shows the exception. Which is pretty annoying
+  // It only works with Firebird 2, though.
+  try
+    if SQLDbType = INTERBASE then
+      begin
+      FConnection.ExecuteDirect('execute block as begin if (exists (select 1 from rdb$relations where rdb$relation_name=''' + ATableName + ''')) '+
+             'then execute statement ''drop table ' + ATAbleName + ';'';end');
+      FTransaction.CommitRetaining;
+      end;
+  except
+    FTransaction.RollbackRetaining;
+  end;
+end;
+
 destructor TSQLDBConnector.Destroy;
 begin
   if assigned(FTransaction) then

packages/fcl-db/tests/testbasics.pas

@@ -37,6 +37,7 @@ var Params  : TParams;
     pb      : TParamBinding;
 begin
   Params := TParams.Create;
+
   AssertEquals(     'select * from table where id = $1',
     params.ParseSQL('select * from table where id = :id',true,True,True,psPostgreSQL));
 
@@ -95,6 +96,14 @@ begin
   AssertEquals(     'select * from table where "id  = :id\',
     params.ParseSQL('select * from table where "id  = :id\',true,True,True,psInterbase));
 
+// Test strange-field names
+  AssertEquals(     'select * from table where "field-name" = ?',
+    params.ParseSQL('select * from table where "field-name" = :"field-name"',true,True,True,psInterbase));
+  AssertEquals('field-name',Params.Items[0].Name);
+
+  AssertEquals(     'select * from table where "field-name" = ?',
+    params.ParseSQL('select * from table where "field-name" = :"field-name',true,True,True,psInterbase));
+
   Params.Free;
 end;
 

packages/fcl-db/tests/testdbbasics.pas

@@ -85,6 +85,7 @@ type
     procedure TestSupportDateFields;
     procedure TestSupportCurrencyFields;
     procedure TestSupportBCDFields;
+    procedure TestSupportFixedStringFields;
 
     procedure TestIsEmpty;
     procedure TestAppendOnEmptyDataset;
@@ -93,6 +94,8 @@ type
     procedure TestBufDatasetCancelUpd; //bug 6938
     procedure TestEofAfterFirst;           //bug 7211
     procedure TestBufDatasetCancelUpd1;
+    procedure TestMultipleDeleteUpdateBuffer;
+    procedure TestDoubleDelete;
     procedure TestDoubleClose;
     procedure TestCalculatedField;
     procedure TestAssignFieldftString;
@@ -123,7 +126,7 @@ type
 
 implementation
 
-uses toolsunit, bufdataset, variants;
+uses toolsunit, bufdataset, variants, strutils;
 
 type THackDataLink=class(TdataLink);
 
@@ -151,6 +154,7 @@ begin
     AssertTrue(eof);
     AssertTrue(bof);
     append;
+    FieldByName('id').AsInteger:=0;
     AssertFalse(Bof);
     AssertTrue(Eof);
     post;
@@ -169,6 +173,7 @@ begin
     AssertTrue(bof);
     AssertTrue(IsEmpty);
     insert;
+    FieldByName('id').AsInteger:=0;
     AssertTrue(Bof);
     AssertTrue(Eof);
     AssertFalse(IsEmpty);
@@ -941,16 +946,20 @@ begin
 end;
 
 procedure TTestDBBasics.FTestXMLDatasetDefinition(ADataset: TDataset);
+var i : integer;
 begin
   AssertEquals(2,ADataset.FieldDefs.Count);
-  AssertEquals(5,ADataset.RecordCount);
   AssertEquals(2,ADataset.Fields.Count);
   AssertEquals('ID',ADataset.Fields[0].FieldName);
   AssertEquals('NAME',ADataset.Fields[1].FieldName);
   AssertTrue('Incorrect fieldtype',ADataset.fields[1].DataType=ftString);
-  AssertEquals('TestName1',ADataset.FieldByName('name').AsString);
-  ADataset.Next;
-  AssertEquals('TestName2',ADataset.FieldByName('name').AsString);
+  i := 1;
+  while not ADataset.EOF do
+    begin
+    AssertEquals('TestName'+inttostr(i),ADataset.FieldByName('name').AsString);
+    ADataset.Next;
+    inc(i);
+    end;
 end;
 
 procedure TTestDBBasics.TestOnFilterProc(DataSet: TDataSet; var Accept: Boolean);
@@ -1804,6 +1813,24 @@ begin
   ds.close;
 end;
 
+procedure TTestDBBasics.TestSupportFixedStringFields;
+var i          : byte;
+    ds         : TDataset;
+    Fld        : TField;
+
+begin
+  TestfieldDefinition(ftFixedChar,10,ds,Fld);
+  for i := 0 to testValuesCount-1 do
+    begin
+    if Fld.IsNull then // If the field is null, .AsString always returns an empty, non-padded string
+      AssertEquals(testStringValues[i],Fld.AsString)
+    else
+      AssertEquals(PadRight(testStringValues[i],10),Fld.AsString);
+    ds.Next;
+    end;
+  ds.close;
+end;
+
 procedure TTestDBBasics.TestDoubleClose;
 begin
   with DBConnector.GetNDataset(1) do
@@ -1994,6 +2021,68 @@ begin
     end;
 end;
 
+procedure TTestDBBasics.TestMultipleDeleteUpdateBuffer;
+var ds    : TDataset;
+begin
+  ds := DBConnector.GetNDataset(true,5);
+  if not (ds is TBufDataset) then
+    Ignore('This test only applies to TBufDataset and descendents.');
+
+  ds.open;
+  with TBufDataset(ds) do
+    begin
+    AssertEquals(0,ChangeCount);
+    edit;
+    fieldbyname('id').asinteger := 500;
+    fieldbyname('name').AsString := 'JoJo';
+    post;
+    AssertEquals(1,ChangeCount);
+    next; next;
+    Delete;
+    AssertEquals(2,ChangeCount);
+    Delete;
+    AssertEquals(3,ChangeCount);
+    CancelUpdates;
+    end;
+  ds.close;
+end;
+
+procedure TTestDBBasics.TestDoubleDelete;
+var ds    : TBufDataset;
+begin
+  ds := TBufDataset(DBConnector.GetNDataset(true,5));
+  if not (ds is TBufDataset) then
+    Ignore('This test only applies to TBufDataset and descendents.');
+
+  with ds do
+    begin
+    open;
+    next; next;
+    Delete;
+    Delete;
+
+    first;
+    AssertEquals(1,fieldbyname('id').AsInteger);
+    next;
+    AssertEquals(2,fieldbyname('id').AsInteger);
+    next;
+    AssertEquals(5,fieldbyname('id').AsInteger);
+
+    CancelUpdates;
+
+    first;
+    AssertEquals(1,fieldbyname('id').AsInteger);
+    next;
+    AssertEquals(2,fieldbyname('id').AsInteger);
+    next;
+    AssertEquals(3,fieldbyname('id').AsInteger);
+    next;
+    AssertEquals(4,fieldbyname('id').AsInteger);
+    next;
+    AssertEquals(5,fieldbyname('id').AsInteger);
+    end;
+end;
+
 procedure TTestDBBasics.TestNullAtOpen;
 begin
   with dbconnector.getndataset(0) do

packages/fcl-db/tests/testfieldtypes.pas

@@ -28,13 +28,13 @@ type
     procedure RunTest; override;
   published
     procedure TestClearUpdateableStatus;
-    procedure TestFixedStringParamQuery;
     procedure TestReadOnlyParseSQL; // bug 9254
     procedure TestParseJoins; // bug 10148
     procedure TestDoubleFieldNames; // bug 8457
     procedure TestParseUnion; // bug 8442
     procedure TestInsertLargeStrFields; // bug 9600
     procedure TestNumericNames; // Bug9661
+    procedure TestApplyUpdFieldnames; // Bug 12275;
     procedure Test11Params;
     procedure TestRowsAffected; // bug 9758
     procedure TestStringsReplace;
@@ -73,9 +73,11 @@ type
     procedure TestNullValues;
     procedure TestParamQuery;
     procedure TestStringParamQuery;
+    procedure TestFixedStringParamQuery;
     procedure TestDateParamQuery;
     procedure TestIntParamQuery;
     procedure TestFloatParamQuery;
+    procedure TestBCDParamQuery;
     procedure TestAggregates;
   end;
 
@@ -89,6 +91,9 @@ const
   testFloatValuesCount = 21;
   testFloatValues : Array[0..testFloatValuesCount-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);
 
+  testBCDValuesCount = 10;
+  testBCDValues : Array[0..testBCDValuesCount-1] of currency = (-100,54.53,1.2345,123.5345,0,1,-1,0,1.42,1324.4324);
+
   testIntValuesCount = 17;
   testIntValues : Array[0..testIntValuesCount-1] of integer = (-maxInt,-maxSmallint-1,-maxSmallint,-256,-255,-128,-127,-1,0,1,127,128,255,256,maxSmallint,maxSmallint+1,MaxInt);
 
@@ -695,6 +700,11 @@ begin
   TestXXParamQuery(ftFloat,'FLOAT',testFloatValuesCount);
 end;
 
+procedure TTestFieldTypes.TestBCDParamQuery;
+begin
+  TestXXParamQuery(ftBCD,'NUMERIC(10,4)',testBCDValuesCount);
+end;
+
 procedure TTestFieldTypes.TestStringParamQuery;
 
 begin
@@ -737,6 +747,7 @@ begin
       case ADataType of
         ftInteger: Params.ParamByName('field1').asinteger := testIntValues[i];
         ftFloat  : Params.ParamByName('field1').AsFloat   := testFloatValues[i];
+        ftBCD    : Params.ParamByName('field1').AsCurrency:= testBCDValues[i];
         ftFixedChar,
         ftString : Params.ParamByName('field1').AsString  := testStringValues[i];
         ftDate   : if cross then
@@ -760,13 +771,15 @@ begin
       case ADataType of
         ftInteger: AssertEquals(testIntValues[i],FieldByName('FIELD1').AsInteger);
         ftFloat  : AssertEquals(testFloatValues[i],FieldByName('FIELD1').AsFloat);
-        ftFixedChar,
-        ftString : begin
+        ftBCD    : AssertEquals(testBCDValues[i],FieldByName('FIELD1').AsCurrency);
+        ftFixedChar :
+                   begin
                    if FieldByName('FIELD1').isnull then
                      AssertEquals(testStringValues[i],FieldByName('FIELD1').AsString)
                    else
                      AssertEquals(PadRight(testStringValues[i],10),FieldByName('FIELD1').AsString);
                    end;
+        ftString : AssertEquals(testStringValues[i],FieldByName('FIELD1').AsString);
         ftdate   : AssertEquals(testDateValues[i],FormatDateTime('yyyy/mm/dd',FieldByName('FIELD1').AsDateTime));
       else
         AssertTrue('no test for paramtype available',False);
@@ -1120,6 +1133,35 @@ begin
     end;
 end;
 
+procedure TTestFieldTypes.TestApplyUpdFieldnames;
+begin
+  with TSQLDBConnector(DBConnector) do
+    begin
+    AssertEquals(-1,query.RowsAffected);
+    Connection.ExecuteDirect('create table FPDEV2 (         ' +
+                              '  ID INT NOT NULL            , ' +
+                              '  "NAME-TEST" VARCHAR(250),  ' +
+                              '  PRIMARY KEY (ID)           ' +
+                              ')                            ');
+// Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
+    TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
+    Connection.ExecuteDirect('insert into FPDEV2(ID,"NAME-TEST") values (1,''test1'')');
+    Query.SQL.Text := 'select * from fpdev2';
+    Query.Open;
+    AssertEquals(1,Query.FieldByName('ID').AsInteger);
+    AssertEquals('test1',Query.FieldByName('NAME-TEST').AsString);
+    Query.Edit;
+    Query.FieldByName('NAME-TEST').AsString:='Edited';
+    Query.Post;
+    Query.ApplyUpdates;
+    Query.Close;
+    Query.Open;
+    AssertEquals(1,Query.FieldByName('ID').AsInteger);
+    AssertEquals('Edited',Query.FieldByName('NAME-TEST').AsString);
+    Query.Close;
+    end;
+end;
+
 procedure TTestFieldTypes.TestRowsAffected;
 begin
   with TSQLDBConnector(DBConnector) do
@@ -1390,7 +1432,7 @@ procedure TTestFieldTypes.TestParametersAndDates;
 // See bug 7205
 var ADateStr : String;
 begin
-  if SQLDbType in [interbase,mysql40,mysql41,mysql50] then Ignore('This test does not apply to this sqldb-connection type, since it doesn''t use semicolons for casts');
+  if SQLDbType in [interbase,mysql40,mysql41,mysql50,sqlite3] then Ignore('This test does not apply to this sqldb-connection type, since it doesn''t use semicolons for casts');
 
   with TSQLDBConnector(DBConnector).Query do
     begin

packages/fcl-db/tests/toolsunit.pas

@@ -162,10 +162,6 @@ procedure InitialiseDBConnector;
 implementation
 
 uses
-  sqldbtoolsunit,
-  dbftoolsunit,
-  memdstoolsunit,
-  SdfDSToolsUnit,
   inifiles;
 
 constructor TDBConnector.create;

packages/fcl-fpcunit/src/DUnitCompatibleInterface.inc

@@ -19,9 +19,14 @@
     class procedure CheckIs(obj :TObject; pClass: TClass; msg: string = ''); overload;
     class procedure CheckSame(expected, actual: TObject; msg: string = ''); overload;
     class procedure FailNotEquals(expected, actual: string; msg: string = ''; errorAddr: Pointer = nil); virtual;
+    class procedure CheckTrue(condition: Boolean; msg: string);
+    class procedure CheckFalse(condition: Boolean; msg: string);
+    class function  EqualsErrorMessage(const expected, actual: string; const ErrorMsg: string): string;
+    class function  NotEqualsErrorMessage(const expected, actual: string; const ErrorMsg: string): string;
 
     class function Suite: TTest;
 
+
     {
     *** TODO  ***
     procedure CheckEqualsBin(expected, actual: longword; msg: string = ''; digits: integer=32); virtual;
@@ -135,6 +140,36 @@ begin
   Fail(msg + ComparisonMsg(Expected, Actual));
 end;
 
+class procedure TAssert.CheckTrue(condition: Boolean; msg: string);
+begin
+  if (not condition) then
+      FailNotEquals(BoolToStr(true, true), BoolToStr(false, true), msg, nil);
+end;
+
+class procedure TAssert.CheckFalse(condition: Boolean; msg: string);
+begin
+  if (condition) then
+      FailNotEquals(BoolToStr(false, true), BoolToStr(true, true), msg, nil);
+end;
+
+class function TAssert.EqualsErrorMessage(const expected, actual: string;
+    const ErrorMsg: string): string;
+begin
+  if (ErrorMsg <> '') then
+    Result := Format(sMsgActualEqualsExpFmt, [ErrorMsg + ', ', expected, actual])
+  else
+    Result := Format(sActualEqualsExpFmt, [expected, actual])
+end;
+
+class function TAssert.NotEqualsErrorMessage(const expected, actual: string;
+    const ErrorMsg: string): string;
+begin
+  if (ErrorMsg <> '') then
+    Result := Format(sExpectedButWasAndMessageFmt, [ErrorMsg, expected, actual])
+  else
+    Result := Format(sExpectedButWasFmt, [expected, actual]);
+end;
+
 class function TAssert.Suite: TTest;
 begin
   result := TTestSuite.Create(self);

packages/fcl-fpcunit/src/fpcunit.pp

@@ -309,6 +309,12 @@ implementation
 uses
   testutils;
 
+Const
+  sExpectedButWasFmt = 'Expected:' + LineEnding + '"%s"' + LineEnding + 'But was:' + LineEnding + '"%s"';
+  sExpectedButWasAndMessageFmt = '%s' + LineEnding + sExpectedButWasFmt;
+  sMsgActualEqualsExpFmt = '%s' + LineEnding + 'Expected ' + LineEnding + '< %s > ' + LineEnding + 'equals actual ' + LineEnding + '< %s >';
+  sActualEqualsExpFmt = 'Expected ' + LineEnding + '< %s > ' + LineEnding + 'equals actual ' + LineEnding + '< %s >';
+
 
 { This lets us use a single include file for both the Interface and
   Implementation sections. }

packages/fcl-image/src/extinterpolation.pp

@@ -12,7 +12,7 @@ of Bessel and Sinc are windowed with Blackman filter.
 interface
 
 uses
-  Classes, SysUtils, FPImage, FPCanvas;
+  Math, Classes, SysUtils, FPImage, FPCanvas;
 
 type
 
@@ -224,7 +224,7 @@ begin
 end;
 
 function BesselOrderOne (x : double) : double;
-var p,q, OneOverSqrt2,sinx,cosx : double;
+var p,OneOverSqrt2,sinx,cosx : double;
 begin
   if x = 0.0 then
     result := 0.0

packages/fcl-image/src/fpcanvas.pp

@@ -17,7 +17,7 @@ unit FPCanvas;
 
 interface
 
-uses sysutils, classes, FPImage;
+uses Math, sysutils, classes, FPImage;
 
 const
   PatternBitCount = sizeof(longword) * 8;
@@ -171,15 +171,12 @@ type
 
   TFPBaseInterpolation = class (TFPCustomInterpolation)
   private
-    xfactor, yfactor : double;
-    xsupport,ysupport : double;
-    tempimage : TFPCustomImage;
-    procedure Horizontal (width : integer);
-    procedure vertical (dx,dy,width,height: integer);
+    procedure CreatePixelWeights (OldSize, NewSize: integer;
+      out Entries: Pointer; out EntrySize: integer; out Support: integer);
   protected
-    procedure Execute (x,y,w,h:integer); override;
-    function Filter (x : double) : double; virtual; abstract;
-    function MaxSupport : double; virtual; abstract;
+    procedure Execute (x,y,w,h : integer); override;
+    function Filter (x : double): double; virtual;
+    function MaxSupport : double; virtual;
   end;
 
   { TMitchelInterpolation }

packages/fcl-image/src/fpinterpolation.inc

@@ -8,177 +8,225 @@ end;
 
 { TFPBaseInterpolation }
 
-type
+procedure TFPBaseInterpolation.CreatePixelWeights(OldSize, NewSize: integer;
+  out Entries: Pointer; out EntrySize: integer; out Support: integer);
+// create an array of #NewSize entries. Each entry starts with an integer
+// for the StartIndex, followed by #Support singles for the pixel weights.
+// The sum of weights for each entry is 1.
+var
+  Entry: Pointer;
 
-  TInterpolationContribution = record
-    weight : double;
-    place : integer;
+  procedure SetSupport(NewSupport: integer);
+  begin
+    Support:=NewSupport;
+    EntrySize:=SizeOf(integer)+SizeOf(Single)*Support;
+    Getmem(Entries,EntrySize*NewSize);
+    Entry:=Entries;
   end;
 
-function ColorRound (c : double) : word;
+var
+  i: Integer;
+  Factor: double;
+  StartPos: Double;
+  StartIndex: Integer;
+  j: Integer;
+  FirstValue: Double;
+  //Sum: double;
 begin
-  if c > $FFFF then
-    result := $FFFF
-  else if c < 0.0 then
-    result := 0
-  else
-    result := round(c);
-end;
-
-procedure TFPBaseInterpolation.Horizontal (width : integer);
-var x,y,r : integer;
-  start, stop, maxcontribs : integer;
-  center, re,gr,bl, density : double;
-  contributions : array[0..10] of TInterpolationContribution;
-  dif, w, gamma, a : double;
-  c : TFPColor;
-begin
-  for x := 0 to width-1 do
+  if NewSize=OldSize then
+  begin
+    SetSupport(1);
+    for i:=0 to NewSize-1 do
     begin
-    center := x * xfactor;
-    start := round (center-xsupport);
-    if start < 0 then
-      start := 0;
-    stop := round(center+xsupport);
-    if stop >= image.Width then
-      stop := image.Width-1;
-    density := 0.0;
-    maxcontribs := -1;
-    for r := start to stop do
+      // 1:1
+      PInteger(Entry)^:=i;
+      inc(Entry,SizeOf(Integer));
+      PSingle(Entry)^:=1.0;
+      inc(Entry,SizeOf(Single));
+    end;
+  end else if NewSize<OldSize then
+  begin
+    // shrink
+    SetSupport(Max(2,(OldSize+NewSize-1) div NewSize));
+    Factor:=double(OldSize)/double(NewSize);
+    for i:=0 to NewSize-1 do
+    begin
+      StartPos:=Factor*i;
+      StartIndex:=Floor(StartPos);
+      PInteger(Entry)^:=StartIndex;
+      inc(Entry,SizeOf(Integer));
+      // first pixel
+      FirstValue:=(1.0-(StartPos-double(StartIndex)));
+      PSingle(Entry)^:=FirstValue/Factor;
+      inc(Entry,SizeOf(Single));
+      // middle pixel
+      for j:=1 to Support-2 do
       begin
-      dif := r - center;
-      w := Filter (dif);
-      if w > 0.0 then
-        begin
-        inc (maxcontribs);
-        with contributions[maxcontribs] do
-          begin
-          weight := w;
-          density := density + w;
-          place := r;
-          end;
-        end;
+        PSingle(Entry)^:=1.0/Factor;
+        inc(Entry,SizeOf(Single));
       end;
-    if (density <> 0.0) and (density <> 1.0) then
+      // last pixel
+      PSingle(Entry)^:=(Factor-FirstValue-(Support-2))/Factor;
+      inc(Entry,SizeOf(Single));
+    end;
+  end else
+  begin
+    // enlarge
+    if OldSize=1 then
+    begin
+      SetSupport(1);
+      for i:=0 to NewSize-1 do
       begin
-      density := 1.0 / density;
-      for r := 0 to maxcontribs do
-        contributions[r].weight := contributions[r].weight * density;
+        // nothing to interpolate
+        PInteger(Entry)^:=0;
+        inc(Entry,SizeOf(Integer));
+        PSingle(Entry)^:=1.0;
+        inc(Entry,SizeOf(Single));
       end;
-    for y := 0 to image.height-1 do
+    end else
+    begin
+      SetSupport(2);
+      Factor:=double(OldSize-1)/double(NewSize);
+      for i:=0 to NewSize-1 do
       begin
-      gamma := 0.0;
-      re := 0.0;
-      gr := 0.0;
-      bl := 0.0;
-      for r := 0 to maxcontribs do
-        with contributions[r] do
-          with image.colors[place,y] do
-            begin
-            a := weight * alpha / $FFFF;
-            re := re + a * image.colors[place,y].red;
-            gr := gr + a * image.colors[place,y].green;
-            bl := bl + a * image.colors[place,y].blue;
-            gamma := gamma + a;
-            end;
-      with c do
-        begin
-        red := ColorRound (re);
-        green := ColorRound (gr);
-        blue := ColorRound (bl);
-        alpha := ColorRound (gamma * $FFFF) ;
-        end;
-      tempimage.colors[x,y] := c;
+        StartPos:=Factor*i+Factor/2;
+        StartIndex:=Floor(StartPos);
+        PInteger(Entry)^:=StartIndex;
+        inc(Entry,SizeOf(Integer));
+        // first pixel
+        FirstValue:=(1.0-(StartPos-double(StartIndex)));
+        // convert linear distribution
+        FirstValue:=Min(1.0,Max(0.0,Filter(FirstValue/MaxSupport)));
+        PSingle(Entry)^:=FirstValue;
+        inc(Entry,SizeOf(Single));
+        // last pixel
+        PSingle(Entry)^:=1.0-FirstValue;
+        inc(Entry,SizeOf(Single));
       end;
     end;
+  end;
+  if Entry<>Entries+EntrySize*NewSize then
+    raise Exception.Create('TFPBase2Interpolation.Execute inconsistency');
 end;
 
-procedure TFPBaseInterpolation.vertical(dx,dy,width,height: integer);
-var x,y,r : integer;
-  start, stop, maxcontribs : integer;
-  center, re,gr,bl, density : double;
-  contributions : array[0..10] of TInterpolationContribution;
-  dif, w, gamma, a : double;
-  c : TFPColor;
+procedure TFPBaseInterpolation.Execute(x, y, w, h: integer);
+// paint Image on Canvas at x,y,w*h
+var
+  dy: Integer;
+  dx: Integer;
+  HorzResized: PFPColor;
+  xEntries: Pointer;
+  xEntrySize: integer;
+  xSupport: integer;// how many horizontal pixel are needed to create one pixel
+  yEntries: Pointer;
+  yEntrySize: integer;
+  ySupport: integer;// how many vertizontal pixel are needed to create one pixel
+  NewSupportLines: LongInt;
+  yEntry: Pointer;
+  SrcStartY: LongInt;
+  LastSrcStartY: LongInt;
+  LastyEntry: Pointer;
+  sy: Integer;
+  xEntry: Pointer;
+  sx: LongInt;
+  cx: Integer;
+  f: Single;
+  NewCol: TFPColor;
+  Col: TFPColor;
+  CurEntry: Pointer;
 begin
-  for y := 0 to height-1 do
+  if (w<=0) or (h<=0) or (image.Width=0) or (image.Height=0) then
+    exit;
+
+  xEntries:=nil;
+  yEntries:=nil;
+  HorzResized:=nil;
+  try
+    CreatePixelWeights(image.Width,w,xEntries,xEntrySize,xSupport);
+    CreatePixelWeights(image.Height,h,yEntries,yEntrySize,ySupport);
+    // create temporary buffer for the horizontally resized pixel for the
+    // current y line
+    GetMem(HorzResized,w*ySupport*SizeOf(TFPColor));
+
+    LastyEntry:=nil;
+    SrcStartY:=0;
+    for dy:=0 to h-1 do
     begin
-    center := y * yfactor;
-    start := round (center-ysupport);
-    if start < 0 then
-      start := 0;
-    stop := round(center+ysupport);
-    if stop >= tempimage.height then
-      stop := tempimage.height-1;
-    density := 0.0;
-    maxcontribs := -1;
-    for r := start to stop do
+      if dy=0 then
+      begin
+        yEntry:=yEntries;
+        SrcStartY:=PInteger(yEntry)^;
+        NewSupportLines:=ySupport;
+      end else
+      begin
+        LastyEntry:=yEntry;
+        LastSrcStartY:=SrcStartY;
+        inc(yEntry,yEntrySize);
+        SrcStartY:=PInteger(yEntry)^;
+        NewSupportLines:=SrcStartY-LastSrcStartY;
+        // move lines up
+        if (NewSupportLines>0) and (ySupport>NewSupportLines) then
+          System.Move(HorzResized[NewSupportLines*w],
+                      HorzResized[0],
+                      (ySupport-NewSupportLines)*w*SizeOf(TFPColor));
+      end;
+
+      // compute new horizontally resized line(s)
+      for sy:=ySupport-NewSupportLines to ySupport-1 do
       begin
-      dif := r - center;
-      w := Filter (dif);
-      if w > 0.0 then
+        xEntry:=xEntries;
+        for dx:=0 to w-1 do
         begin
-        inc (maxcontribs);
-        with contributions[maxcontribs] do
+          sx:=PInteger(xEntry)^;
+          inc(xEntry,SizeOf(integer));
+          NewCol:=colBlack;
+          for cx:=0 to xSupport-1 do
           begin
-          weight := w;
-          density := density + w;
-          place := r;
+            f:=PSingle(xEntry)^;
+            inc(xEntry,SizeOf(Single));
+            Col:=image.Colors[sx+cx,SrcStartY+sy];
+            NewCol.red:=Min(NewCol.red+round(Col.red*f),$ffff);
+            NewCol.green:=Min(NewCol.green+round(Col.green*f),$ffff);
+            NewCol.blue:=Min(NewCol.blue+round(Col.blue*f),$ffff);
+            NewCol.alpha:=Min(NewCol.alpha+round(Col.alpha*f),$ffff);
           end;
+          HorzResized[dx+sy*w]:=NewCol;
         end;
       end;
-    if (density <> 0.0) and (density <> 1.0) then
-      begin
-      density := 1.0 / density;
-      for r := 0 to maxcontribs do
-        contributions[r].weight := contributions[r].weight * density;
-      end;
-    for x := 0 to width-1 do
+
+      // compute new vertically resized line
+      for dx:=0 to w-1 do
       begin
-      gamma := 0.0;
-      re := 0.0;
-      gr := 0.0;
-      bl := 0.0;
-      for r := 0 to maxcontribs do
-        with contributions[r] do
-          with tempimage.colors[x,place] do
-            begin
-            a := weight * alpha / $FFFF;
-            re := re + a * red;
-            gr := gr + a * green;
-            bl := bl + a * blue;
-            gamma := gamma + a;
-            end;
-      with c do
+        CurEntry:=yEntry+SizeOf(integer);
+        NewCol:=colBlack;
+        for sy:=0 to ySupport-1 do
         begin
-        red := ColorRound (re);
-        green := ColorRound (gr);
-        blue := ColorRound (bl);
-        alpha := ColorRound (gamma * $FFFF);
+          f:=PSingle(CurEntry)^;
+          inc(CurEntry,SizeOf(Single));
+          Col:=HorzResized[dx+sy*w];
+          NewCol.red:=Min(NewCol.red+round(Col.red*f),$ffff);
+          NewCol.green:=Min(NewCol.green+round(Col.green*f),$ffff);
+          NewCol.blue:=Min(NewCol.blue+round(Col.blue*f),$ffff);
+          NewCol.alpha:=Min(NewCol.alpha+round(Col.alpha*f),$ffff);
         end;
-      canvas.colors[x+dx,y+dy] := c;
+        Canvas.Colors[x+dx,y+dy]:=NewCol;
       end;
     end;
+  finally
+    if xEntries<>nil then FreeMem(xEntries);
+    if yEntries<>nil then FreeMem(yEntries);
+    if HorzResized<>nil then FreeMem(HorzResized);
+  end;
 end;
 
-procedure TFPBaseInterpolation.Execute(x, y, w, h: integer);
-var maxy : integer;
-    rx,ry : integer;
+function TFPBaseInterpolation.Filter(x: double): double;
 begin
-  tempimage := TFPMemoryImage.Create (w,image.height);
-  tempimage.UsePalette := false;
-  xfactor := image.Width / w;
-  yfactor := image.Height / h;
-  if xfactor > 1.0 then
-    xsupport := MaxSupport
-  else
-    xsupport := xfactor * MaxSupport;
-  if yfactor > 1.0 then
-    ysupport := MaxSupport
-  else
-    ysupport := yfactor * MaxSupport;
-  Horizontal (w);
-  Vertical (x,y,w,h);
+  Result:=x;
+end;
+
+function TFPBaseInterpolation.MaxSupport: double;
+begin
+  Result:=1.0;
 end;
 
 { TMitchelInterpolation }

packages/fcl-image/src/fpreadtiff.pas

@@ -18,11 +18,11 @@
     RGB 8,16bit (optional alpha),
     Orientation,
     skipping Thumbnail to read first image,
-    compression: packbits,
+    compression: packbits, (LZW started)
     endian
 
   ToDo:
-    Compression: deflate, jpeg, ...
+    Compression: LZW, deflate, jpeg, ...
     Planar
     ColorMap
     multiple images
@@ -38,14 +38,19 @@ unit FPReadTiff;
 interface
 
 uses
-  Classes, SysUtils, FPimage, ctypes, FPTiffCmn;
+  Math, Classes, SysUtils, FPimage, ctypes, FPTiffCmn;
 
 type
+  TFPReaderTiff = class;
+
+  TTiffCreateCompatibleImgEvent = procedure(Sender: TFPReaderTiff;
+                                        var NewImage: TFPCustomImage) of object;
 
   { TFPReaderTiff }
 
   TFPReaderTiff = class(TFPCustomImageReader)
   private
+    FOnCreateImage: TTiffCreateCompatibleImgEvent;
     FReverserEndian: boolean;
     IDF: TTiffIDF;
     FDebug: boolean;
@@ -76,6 +81,7 @@ type
     function FixEndian(w: Word): Word; inline;
     function FixEndian(d: DWord): DWord; inline;
     procedure DecompressPackBits(var Buffer: Pointer; var Count: PtrInt);
+    procedure DecompressLZW(var Buffer: Pointer; var Count: PtrInt);
   protected
     procedure InternalRead(Str: TStream; AnImage: TFPCustomImage); override;
     function InternalCheck(Str: TStream): boolean; override;
@@ -89,6 +95,8 @@ type
     property StartPos: int64 read fStartPos;
     property ReverserEndian: boolean read FReverserEndian;
     property TheStream: TStream read s;
+    property OnCreateImage: TTiffCreateCompatibleImgEvent read FOnCreateImage
+                                                          write FOnCreateImage;
   end;
 
 implementation
@@ -115,8 +123,12 @@ procedure TFPReaderTiff.LoadFromStream(aStream: TStream);
 var
   IFDStart: LongWord;
   i: Integer;
+  aContinue: Boolean;
 begin
   Clear;
+  aContinue:=true;
+  Progress(psStarting, 0, False, Rect(0,0,0,0), '', aContinue);
+  if not aContinue then exit;
   s:=aStream;
   fStartPos:=s.Position;
   ReadTiffHeader(false,IFDStart);
@@ -126,6 +138,7 @@ begin
     ReadImage(i);
     inc(i);
   end;
+  Progress(psEnding, 100, False, Rect(0,0,0,0), '', aContinue);
 end;
 
 function TFPReaderTiff.ReadTiffHeader(QuickTest: boolean; out IFD: DWord): boolean;
@@ -200,6 +213,7 @@ var
   EntryStart: LongWord;
   NewEntryTag: Word;
   UValue: LongWord;
+  SValue: integer;
   WordBuffer: PWord;
   Count: DWord;
   i: Integer;
@@ -255,18 +269,17 @@ begin
       // BitsPerSample
       IDF.BitsPerSample:=DWord(s.Position-fStartPos-2);
       ReadShortValues(IDF.BitsPerSample,WordBuffer,Count);
-      try
-        SetLength(IDF.BitsPerSampleArray,Count);
-        for i:=0 to Count-1 do
-          IDF.BitsPerSampleArray[i]:=WordBuffer[i];
-      finally
-        ReAllocMem(WordBuffer,0);
-      end;
       if Debug then begin
         write('TFPReaderTiff.ReadDirectoryEntry BitsPerSample: ');
         for i:=0 to Count-1 do
           write(IntToStr(WordBuffer[i]),' ');
         writeln;
+      end;
+      try
+        SetLength(IDF.BitsPerSampleArray,Count);
+        for i:=0 to Count-1 do
+          IDF.BitsPerSampleArray[i]:=WordBuffer[i];
+      finally
         ReAllocMem(WordBuffer,0);
       end;
     end;
@@ -313,6 +326,7 @@ begin
       2: ; // RGB 0,0,0 is black
       3: ; // Palette color
       4: ; // Transparency Mask
+      5: ; // CMYK
       else
         TiffError('expected PhotometricInterpretation, but found '+IntToStr(UValue));
       end;
@@ -325,6 +339,7 @@ begin
         2: write('2=RGB 0,0,0 is black');
         3: write('3=Palette color');
         4: write('4=Transparency Mask');
+        5: write('5=CMYK 8bit');
         end;
         writeln;
       end;
@@ -395,7 +410,8 @@ begin
     begin
       // Make - scanner manufacturer
       IDF.Make_ScannerManufacturer:=ReadEntryString;
-      writeln('TFPReaderTiff.ReadDirectoryEntry Make_ScannerManufacturer=',IDF.Make_ScannerManufacturer);
+      if Debug then
+        writeln('TFPReaderTiff.ReadDirectoryEntry Make_ScannerManufacturer=',IDF.Make_ScannerManufacturer);
     end;
   272:
     begin
@@ -492,17 +508,17 @@ begin
   284:
     begin
       // PlanarConfiguration
-      UValue:=ReadEntryUnsigned;
-      case UValue of
+      SValue:=ReadEntrySigned;
+      case SValue of
       1: ; // chunky format
       2: ; // planar format
       else
-        TiffError('expected PlanarConfiguration, but found '+IntToStr(UValue));
+        TiffError('expected PlanarConfiguration, but found '+IntToStr(SValue));
       end;
-      IDF.PlanarConfiguration:=UValue;
+      IDF.PlanarConfiguration:=SValue;
       if Debug then begin
         write('TFPReaderTiff.ReadDirectoryEntry PlanarConfiguration=');
-        case UValue of
+        case SValue of
         1: write('chunky format');
         2: write('planar format');
         end;
@@ -673,6 +689,18 @@ begin
       // long: 32bit unsigned long
       Result:=cint32(ReadDWord);
     end;
+  6: begin
+      // sbyte: 8bit signed
+      Result:=cint8(ReadByte);
+    end;
+  8: begin
+      // sshort: 16bit signed
+      Result:=cint16(ReadWord);
+    end;
+  9: begin
+      // slong: 32bit signed long
+      Result:=cint32(ReadDWord);
+    end;
   else
     TiffError('expected single signed value, but found type='+IntToStr(EntryType));
   end;
@@ -829,6 +857,7 @@ begin
   p:=nil;
   try
     ReadValues(StreamPos,EntryType,Count,p,ByteCount);
+    //writeln('ReadShortValues ',FReverseEndian,' ',EntryType,' Count=',Count,' ByteCount=',ByteCount);
     if Count=0 then exit;
     if EntryType=3 then begin
       // short
@@ -837,6 +866,7 @@ begin
       if FReverseEndian then
         for i:=0 to Count-1 do
           Buffer[i]:=FixEndian(Buffer[i]);
+      //for i:=0 to Count-1 do writeln(i,' ',Buffer[i]);
     end else
       TiffError('only short allowed, but found '+IntToStr(EntryType));
   finally
@@ -859,7 +889,7 @@ var
   y: DWord;
   y2: DWord;
   x: DWord;
-  Pixel: DWord;
+  GrayValue: DWord;
   dx: LongInt;
   dy: LongInt;
   SampleCnt: DWord;
@@ -879,7 +909,11 @@ var
   BlueBits: Word;
   AlphaBits: Word;
   BytesPerPixel: Integer;
+  aContinue: Boolean;
 begin
+  CurImg:=nil;
+  if Debug then
+    writeln('TFPReaderTiff.ReadImage Index=',Index);
   if IDF.PhotoMetricInterpretation=High(IDF.PhotoMetricInterpretation) then
     TiffError('missing PhotometricInterpretation');
   if IDF.RowsPerStrip=0 then
@@ -894,32 +928,8 @@ begin
     // Image already read
     exit;
   end;
-  CurImg:=FirstImg.Img;
-  FirstImg.Assign(IDF);
-
-  ClearTiffExtras(CurImg);
-  // set Tiff extra attributes
-  CurImg.Extra[TiffPhotoMetric]:=IntToStr(IDF.PhotoMetricInterpretation);
-  //writeln('TFPReaderTiff.ReadImage PhotoMetric=',CurImg.Extra[TiffPhotoMetric]);
-  if IDF.Artist<>'' then
-    CurImg.Extra[TiffArtist]:=IDF.Artist;
-  if IDF.Copyright<>'' then
-    CurImg.Extra[TiffCopyright]:=IDF.Copyright;
-  if IDF.DocumentName<>'' then
-    CurImg.Extra[TiffDocumentName]:=IDF.DocumentName;
-  if IDF.DateAndTime<>'' then
-    CurImg.Extra[TiffDateTime]:=IDF.DateAndTime;
-  if IDF.ImageDescription<>'' then
-    CurImg.Extra[TiffImageDescription]:=IDF.ImageDescription;
-  if IDF.Orientation<>0 then
-    CurImg.Extra[TiffOrientation]:=IntToStr(IDF.Orientation);
-  if IDF.ResolutionUnit<>0 then
-    CurImg.Extra[TiffResolutionUnit]:=IntToStr(IDF.ResolutionUnit);
-  if (IDF.XResolution.Numerator<>0) or (IDF.XResolution.Denominator<>0) then
-    CurImg.Extra[TiffXResolution]:=TiffRationalToStr(IDF.XResolution);
-  if (IDF.YResolution.Numerator<>0) or (IDF.YResolution.Denominator<>0) then
-    CurImg.Extra[TiffYResolution]:=TiffRationalToStr(IDF.YResolution);
-  //WriteTiffExtras('ReadImage',CurImg);
+  if Debug then
+    writeln('TFPReaderTiff.ReadImage reading ...');
 
   StripCount:=((IDF.ImageHeight-1) div IDF.RowsPerStrip)+1;
   StripOffsets:=nil;
@@ -946,13 +956,15 @@ begin
 
     case IDF.PhotoMetricInterpretation of
     0,1: if SampleCnt-ExtraSampleCnt<>1 then
-      TiffError('gray images expects one sample per pixel, but found '+IntToStr(SampleCnt));
+      TiffError('gray images expect one sample per pixel, but found '+IntToStr(SampleCnt));
     2: if SampleCnt-ExtraSampleCnt<>3 then
-      TiffError('rgb images expects three samples per pixel, but found '+IntToStr(SampleCnt));
+      TiffError('rgb images expect three samples per pixel, but found '+IntToStr(SampleCnt));
     3: if SampleCnt-ExtraSampleCnt<>1 then
-      TiffError('palette images expects one sample per pixel, but found '+IntToStr(SampleCnt));
+      TiffError('palette images expect one sample per pixel, but found '+IntToStr(SampleCnt));
     4: if SampleCnt-ExtraSampleCnt<>1 then
-      TiffError('mask images expects one sample per pixel, but found '+IntToStr(SampleCnt));
+      TiffError('mask images expect one sample per pixel, but found '+IntToStr(SampleCnt));
+    5: if SampleCnt-ExtraSampleCnt<>4 then
+      TiffError('cmyk images expect four samples per pixel, but found '+IntToStr(SampleCnt));
     end;
 
     GrayBits:=0;
@@ -965,29 +977,46 @@ begin
     0,1:
       begin
         GrayBits:=SampleBits[0];
-        CurImg.Extra[TiffGrayBits]:=IntToStr(GrayBits);
+        IDF.GrayBits:=GrayBits;
         for i:=0 to ExtraSampleCnt-1 do
           if ExtraSamples[i]=2 then begin
-            AlphaBits:=SampleBits[3+i];
-            CurImg.Extra[TiffAlphaBits]:=IntToStr(AlphaBits);
+            AlphaBits:=SampleBits[1+i];
+            IDF.AlphaBits:=AlphaBits;
           end;
       end;
     2:
       begin
         RedBits:=SampleBits[0];
-        GreenBits:=SampleBits[0];
-        BlueBits:=SampleBits[0];
-        CurImg.Extra[TiffRedBits]:=IntToStr(RedBits);
-        CurImg.Extra[TiffGreenBits]:=IntToStr(GreenBits);
-        CurImg.Extra[TiffBlueBits]:=IntToStr(BlueBits);
+        GreenBits:=SampleBits[1];
+        BlueBits:=SampleBits[2];
+        IDF.RedBits:=RedBits;
+        IDF.GreenBits:=GreenBits;
+        IDF.BlueBits:=BlueBits;
         for i:=0 to ExtraSampleCnt-1 do
           if ExtraSamples[i]=2 then begin
             AlphaBits:=SampleBits[3+i];
-            CurImg.Extra[TiffAlphaBits]:=IntToStr(AlphaBits);
+            IDF.AlphaBits:=AlphaBits;
+          end;
+      end;
+    5:
+      begin
+        RedBits:=SampleBits[0];
+        GreenBits:=SampleBits[1];
+        BlueBits:=SampleBits[2];
+        GrayBits:=SampleBits[3];
+        IDF.RedBits:=RedBits;
+        IDF.GreenBits:=GreenBits;
+        IDF.BlueBits:=BlueBits;
+        IDF.GrayBits:=GrayBits;
+        for i:=0 to ExtraSampleCnt-1 do
+          if ExtraSamples[i]=2 then begin
+            AlphaBits:=SampleBits[4+i];
+            IDF.AlphaBits:=AlphaBits;
           end;
       end;
     end;
     BytesPerPixel:=(GrayBits+RedBits+GreenBits+BlueBits+AlphaBits) div 8;
+    IDF.BytesPerPixel:=BytesPerPixel;
 
     if not (IDF.FillOrder in [0,1]) then
       TiffError('FillOrder unsupported: '+IntToStr(IDF.FillOrder));
@@ -997,14 +1026,58 @@ begin
         TiffError('SampleBits unsupported: '+IntToStr(SampleBits[StripIndex]));
     end;
 
+    // get image
+    FirstImg.Assign(IDF);
+    CurImg:=FirstImg.Img;
+    if Assigned(OnCreateImage) then begin
+      OnCreateImage(Self,CurImg);
+      FirstImg.Img:=CurImg;
+    end;
     if CurImg=nil then exit;
+
+    ClearTiffExtras(CurImg);
+    // set Tiff extra attributes
+    CurImg.Extra[TiffPhotoMetric]:=IntToStr(IDF.PhotoMetricInterpretation);
+    //writeln('TFPReaderTiff.ReadImage PhotoMetric=',CurImg.Extra[TiffPhotoMetric]);
+    if IDF.Artist<>'' then
+      CurImg.Extra[TiffArtist]:=IDF.Artist;
+    if IDF.Copyright<>'' then
+      CurImg.Extra[TiffCopyright]:=IDF.Copyright;
+    if IDF.DocumentName<>'' then
+      CurImg.Extra[TiffDocumentName]:=IDF.DocumentName;
+    if IDF.DateAndTime<>'' then
+      CurImg.Extra[TiffDateTime]:=IDF.DateAndTime;
+    if IDF.ImageDescription<>'' then
+      CurImg.Extra[TiffImageDescription]:=IDF.ImageDescription;
+    if not (IDF.Orientation in [1..8]) then
+      IDF.Orientation:=1;
+    CurImg.Extra[TiffOrientation]:=IntToStr(IDF.Orientation);
+    if IDF.ResolutionUnit<>0 then
+      CurImg.Extra[TiffResolutionUnit]:=IntToStr(IDF.ResolutionUnit);
+    if (IDF.XResolution.Numerator<>0) or (IDF.XResolution.Denominator<>0) then
+      CurImg.Extra[TiffXResolution]:=TiffRationalToStr(IDF.XResolution);
+    if (IDF.YResolution.Numerator<>0) or (IDF.YResolution.Denominator<>0) then
+      CurImg.Extra[TiffYResolution]:=TiffRationalToStr(IDF.YResolution);
+    CurImg.Extra[TiffRedBits]:=IntToStr(IDF.RedBits);
+    CurImg.Extra[TiffGreenBits]:=IntToStr(IDF.GreenBits);
+    CurImg.Extra[TiffBlueBits]:=IntToStr(IDF.BlueBits);
+    CurImg.Extra[TiffGrayBits]:=IntToStr(IDF.GrayBits);
+    CurImg.Extra[TiffAlphaBits]:=IntToStr(IDF.AlphaBits);
+    //WriteTiffExtras('ReadImage',CurImg);
+
     case IDF.Orientation of
     0,1..4: CurImg.SetSize(IDF.ImageWidth,IDF.ImageHeight);
     5..8: CurImg.SetSize(IDF.ImageHeight,IDF.ImageWidth);
     end;
 
+
     y:=0;
     for StripIndex:=0 to StripCount-1 do begin
+      // progress
+      aContinue:=true;
+      Progress(psRunning, 0, false, Rect(0,0,0,0), '', aContinue);
+      if not aContinue then break;
+
       CurOffset:=StripOffsets[StripIndex];
       CurByteCnt:=StripByteCounts[StripIndex];
       //writeln('TFPReaderTiff.ReadImage CurOffset=',CurOffset,' CurByteCnt=',CurByteCnt);
@@ -1017,6 +1090,7 @@ begin
       case IDF.Compression of
       1: ; // not compressed
       2: DecompressPackBits(Strip,CurByteCnt); // packbits
+      5: DecompressLZW(Strip,CurByteCnt); // LZW
       else
         TiffError('compression '+IntToStr(IDF.Compression)+' not supported yet');
       end;
@@ -1037,20 +1111,20 @@ begin
           0,1:
             begin
               if GrayBits=8 then begin
-                Pixel:=PCUInt8(Strip)[Run];
-                Pixel:=Pixel shl 8+Pixel;
+                GrayValue:=PCUInt8(Strip)[Run];
+                GrayValue:=GrayValue shl 8+GrayValue;
                 inc(Run);
               end else if GrayBits=16 then begin
-                Pixel:=FixEndian(PCUInt16(@Strip[Run])^);
+                GrayValue:=FixEndian(PCUInt16(@Strip[Run])^);
                 inc(Run,2);
               end else
                 TiffError('gray image only supported with BitsPerSample 8 or 16 not yet supported');
               if IDF.PhotoMetricInterpretation=0 then
-                Pixel:=$ffff-Pixel;
+                GrayValue:=$ffff-GrayValue;
               AlphaValue:=alphaOpaque;
               for i:=0 to ExtraSampleCnt-1 do begin
                 if ExtraSamples[i]=2 then begin
-                  if SampleBits[3+i]=8 then begin
+                  if SampleBits[1+i]=8 then begin
                     AlphaValue:=PCUInt8(Strip)[Run];
                     AlphaValue:=AlphaValue shl 8+AlphaValue;
                     inc(Run);
@@ -1062,10 +1136,10 @@ begin
                   inc(Run,ExtraSamples[i] div 8);
                 end;
               end;
-              Col:=FPColor(Pixel,Pixel,Pixel,AlphaValue);
+              Col:=FPColor(GrayValue,GrayValue,GrayValue,AlphaValue);
             end;
 
-          2:
+          2: // RGB(A)
             begin
               if RedBits=8 then begin
                 RedValue:=PCUInt8(Strip)[Run];
@@ -1108,6 +1182,64 @@ begin
               end;
               Col:=FPColor(RedValue,GreenValue,BlueValue,AlphaValue);
             end;
+
+          5: // CMYK plus optional alpha
+            begin
+              if RedBits=8 then begin
+                RedValue:=PCUInt8(Strip)[Run];
+                RedValue:=RedValue shl 8+RedValue;
+                inc(Run);
+              end else begin
+                RedValue:=FixEndian(PCUInt16(@Strip[Run])^);
+                inc(Run,2);
+              end;
+              if GreenBits=8 then begin
+                GreenValue:=PCUInt8(Strip)[Run];
+                GreenValue:=GreenValue shl 8+GreenValue;
+                inc(Run);
+              end else begin
+                GreenValue:=FixEndian(PCUInt16(@Strip[Run])^);
+                inc(Run,2);
+              end;
+              if BlueBits=8 then begin
+                BlueValue:=PCUInt8(Strip)[Run];
+                BlueValue:=BlueValue shl 8+BlueValue;
+                inc(Run);
+              end else begin
+                BlueValue:=FixEndian(PCUInt16(@Strip[Run])^);
+                inc(Run,2);
+              end;
+              if GrayBits=8 then begin
+                GrayValue:=PCUInt8(Strip)[Run];
+                GrayValue:=GrayValue shl 8+GrayValue;
+                inc(Run);
+              end else begin
+                GrayValue:=FixEndian(PCUInt16(@Strip[Run])^);
+                inc(Run,2);
+              end;
+              AlphaValue:=alphaOpaque;
+              for i:=0 to ExtraSampleCnt-1 do begin
+                if ExtraSamples[i]=2 then begin
+                  if SampleBits[4+i]=8 then begin
+                    AlphaValue:=PCUInt8(Strip)[Run];
+                    AlphaValue:=AlphaValue shl 8+AlphaValue;
+                    inc(Run);
+                  end else begin
+                    AlphaValue:=FixEndian(PCUInt16(@Strip[Run])^);
+                    inc(Run,2);
+                  end;
+                end else begin
+                  inc(Run,ExtraSamples[i] div 8);
+                end;
+              end;
+              // CMYK to RGB
+              RedValue:=Max(0,integer($ffff)-RedValue-GrayBits);
+              GreenValue:=Max(0,integer($ffff)-GreenValue-GrayBits);
+              BlueValue:=Max(0,integer($ffff)-BlueValue-GrayBits);
+              // set color
+              Col:=FPColor(RedValue,GreenValue,BlueValue,AlphaValue);
+            end;
+
           else
             TiffError('PhotometricInterpretation='+IntToStr(IDF.PhotoMetricInterpretation)+' not supported');
           end;
@@ -1222,6 +1354,220 @@ begin
   Count:=NewCount;
 end;
 
+procedure TFPReaderTiff.DecompressLZW(var Buffer: Pointer; var Count: PtrInt);
+type
+  TLZWString = packed record
+    Count: integer;
+    Data: PByte;
+  end;
+  PLZWString = ^TLZWString;
+const
+  EoiCode = 257;
+  ClearCode = 256;
+var
+  NewBuffer: PByte;
+  NewCount: PtrInt;
+  NewCapacity: PtrInt;
+  SrcPos: PtrInt;
+  SrcPosBit: integer;
+  CurBitLength: integer;
+  Code: Word;
+  Table: PLZWString;
+  TableCapacity: integer;
+  TableCount: integer;
+  OldCode: Word;
+
+  function GetNextCode: Word;
+  var
+    v: Integer;
+  begin
+    Result:=0;
+    // CurBitLength can be 9 to 12
+    writeln('GetNextCode CurBitLength=',CurBitLength,' SrcPos=',SrcPos,' SrcPosBit=',SrcPosBit,' ',hexstr(PByte(Buffer)[SrcPos],2),' ',hexstr(PByte(Buffer)[SrcPos+1],2),' ',hexstr(PByte(Buffer)[SrcPos+2],2));
+    // read two or three bytes
+    if CurBitLength+SrcPosBit>16 then begin
+      // read from three bytes
+      if SrcPos+3>Count then TiffError('LZW stream overrun');
+      v:=PByte(Buffer)[SrcPos];
+      inc(SrcPos);
+      v:=(v shl 8)+PByte(Buffer)[SrcPos];
+      inc(SrcPos);
+      v:=(v shl 8)+PByte(Buffer)[SrcPos];
+      v:=v shr (24-CurBitLength-SrcPosBit);
+    end else begin
+      // read from two bytes
+      if SrcPos+2>Count then TiffError('LZW stream overrun');
+      v:=PByte(Buffer)[SrcPos];
+      inc(SrcPos);
+      v:=(v shl 8)+PByte(Buffer)[SrcPos];
+      if CurBitLength+SrcPosBit=16 then
+        inc(SrcPos);
+      v:=v shr (16-CurBitLength-SrcPosBit);
+    end;
+    Result:=v and ((1 shl CurBitLength)-1);
+    SrcPosBit:=(SrcPosBit+CurBitLength) and 7;
+    writeln('GetNextCode END SrcPos=',SrcPos,' SrcPosBit=',SrcPosBit,' Result=',Result,' Result=',hexstr(Result,4));
+  end;
+
+  procedure ClearTable;
+  var
+    i: Integer;
+  begin
+    for i:=0 to TableCount-1 do
+      ReAllocMem(Table[i].Data,0);
+    TableCount:=0;
+  end;
+
+  procedure InitializeTable;
+  begin
+    CurBitLength:=9;
+    ClearTable;
+  end;
+
+  function IsInTable(Code: word): boolean;
+  begin
+    Result:=Code<258+TableCount;
+  end;
+
+  procedure WriteStringFromCode(Code: integer; AddFirstChar: boolean = false);
+  var
+    s: TLZWString;
+    b: byte;
+    i: Integer;
+  begin
+    WriteLn('WriteStringFromCode Code=',Code,' AddFirstChar=',AddFirstChar);
+    if Code<256 then begin
+      // write byte
+      b:=Code;
+      s.Data:=@b;
+      s.Count:=1;
+    end else begin
+      // write string
+      if Code-258>=TableCount then
+        TiffError('LZW code out of bounds');
+      s:=Table[Code-258];
+    end;
+    if NewCount+s.Count+1>NewCapacity then begin
+      NewCapacity:=NewCapacity*2+8;
+      ReAllocMem(NewBuffer,NewCapacity);
+    end;
+    System.Move(s.Data^,NewBuffer[NewCount],s.Count);
+    for i:=0 to s.Count-1 do
+      write(HexStr(NewBuffer[NewCount+i],2));
+    inc(NewCount,s.Count);
+    if AddFirstChar then begin
+      NewBuffer[NewCount]:=s.Data^;
+      write(HexStr(NewBuffer[NewCount],2));
+      inc(NewCount);
+    end;
+    writeln(',WriteStringFromCode');
+  end;
+
+  procedure AddStringToTable(Code, AddFirstCharFromCode: integer);
+  // add string from code plus first character of string from code as new string
+  var
+    b: byte;
+    s1, s2: TLZWString;
+    p: PByte;
+  begin
+    WriteLn('AddStringToTable Code=',Code,' FCFCode=',AddFirstCharFromCode,' TableCount=',TableCount,' TableCapacity=',TableCapacity);
+    // grow table
+    if TableCount>=TableCapacity then begin
+      TableCapacity:=TableCapacity*2+128;
+      ReAllocMem(Table,TableCapacity*SizeOf(TLZWString));
+    end;
+    // find string 1
+    if Code<256 then begin
+      // string is byte
+      b:=Code;
+      s1.Data:=@b;
+      s1.Count:=1;
+    end else begin
+      // normal string
+      if Code-258>=TableCount then
+        TiffError('LZW code out of bounds');
+      s1:=Table[Code-258];
+    end;
+    // find string 2
+    if AddFirstCharFromCode<256 then begin
+      // string is byte
+      b:=AddFirstCharFromCode;
+      s2.Data:=@b;
+      s2.Count:=1;
+    end else begin
+      // normal string
+      if AddFirstCharFromCode-258>=TableCount then
+        TiffError('LZW code out of bounds');
+      s2:=Table[AddFirstCharFromCode-258];
+    end;
+    // set new table entry
+    Table[TableCount].Count:=s1.Count+1;
+    p:=nil;
+    GetMem(p,s1.Count+1);
+    Table[TableCount].Data:=p;
+    System.Move(s1.Data^,p^,s1.Count);
+    // add first character from string 2
+    p[s1.Count]:=s2.Data^;
+    // increase TableCount
+    inc(TableCount);
+    case TableCount+259 of
+    512,1024,2048: inc(CurBitLength);
+    4096: TiffError('LZW too many codes');
+    end;
+  end;
+
+begin
+  WriteLn('TFPReaderTiff.DecompressLZW START Count=',Count);
+  for SrcPos:=0 to 19 do
+    write(HexStr(PByte(Buffer)[SrcPos],2));
+  writeln();
+
+  NewBuffer:=nil;
+  NewCount:=0;
+  NewCapacity:=Count*2;
+  ReAllocMem(NewBuffer,NewCapacity);
+
+  SrcPos:=0;
+  SrcPosBit:=0;
+  CurBitLength:=9;
+  Table:=nil;
+  TableCount:=0;
+  TableCapacity:=0;
+  try
+    repeat
+      Code:=GetNextCode;
+      WriteLn('TFPReaderTiff.DecompressLZW Code=',Code);
+      if Code=EoiCode then break;
+      if Code=ClearCode then begin
+        InitializeTable;
+        Code:=GetNextCode;
+        if Code=EoiCode then break;
+        WriteStringFromCode(Code);
+        OldCode:=Code;
+      end else begin
+        if Code<TableCount+258 then begin
+          WriteStringFromCode(Code);
+          AddStringToTable(OldCode,Code);
+          OldCode:=Code;
+        end else if Code=TableCount+258 then begin
+          WriteStringFromCode(OldCode,true);
+          AddStringToTable(OldCode,OldCode);
+          OldCode:=Code;
+        end else
+          TiffError('LZW code out of bounds');
+      end;
+    until false;
+  finally
+    ClearTable;
+    ReAllocMem(Table,0);
+  end;
+
+  ReAllocMem(NewBuffer,NewCount);
+  FreeMem(Buffer);
+  Buffer:=NewBuffer;
+  Count:=NewCount;
+end;
+
 procedure TFPReaderTiff.InternalRead(Str: TStream; AnImage: TFPCustomImage);
 begin
   FirstImg.Img:=AnImage;

packages/fcl-image/src/fptiffcmn.pas

@@ -29,14 +29,15 @@ type
 
 const
   TiffRational0: TTiffRational = (Numerator: 0; Denominator: 0);
+  TiffRational72: TTiffRational = (Numerator: 72; Denominator: 1);
 
   // TFPCustomImage.Extra properties used by TFPReaderTiff and TFPWriterTiff
   TiffExtraPrefix = 'Tiff';
   TiffPhotoMetric = TiffExtraPrefix+'PhotoMetricInterpretation';
-  TiffGrayBits = TiffExtraPrefix+'GrayBits';
-  TiffRedBits = TiffExtraPrefix+'RedBits';
-  TiffGreenBits = TiffExtraPrefix+'GreenBits';
-  TiffBlueBits = TiffExtraPrefix+'BlueBits';
+  TiffGrayBits = TiffExtraPrefix+'GrayBits'; // CMYK: key plate
+  TiffRedBits = TiffExtraPrefix+'RedBits'; // CMYK: cyan
+  TiffGreenBits = TiffExtraPrefix+'GreenBits'; // CMYK: magenta
+  TiffBlueBits = TiffExtraPrefix+'BlueBits'; // CMYK: yellow
   TiffAlphaBits = TiffExtraPrefix+'AlphaBits';
   TiffArtist = TiffExtraPrefix+'Artist';
   TiffCopyright = TiffExtraPrefix+'Copyright';
@@ -87,7 +88,14 @@ type
     Treshholding: DWord;
     XResolution: TTiffRational;
     YResolution: TTiffRational;
+    // image
     Img: TFPCustomImage;
+    RedBits: word;
+    GreenBits: word;
+    BlueBits: word;
+    GrayBits: word;
+    AlphaBits: word;
+    BytesPerPixel: Word;
     procedure Clear;
     procedure Assign(IDF: TTiffIDF);
   end;
@@ -180,6 +188,13 @@ begin
   FillOrder:=0;
   Orientation:=0;
   Treshholding:=0;
+
+  RedBits:=0;
+  GreenBits:=0;
+  BlueBits:=0;
+  GrayBits:=0;
+  AlphaBits:=0;
+  BytesPerPixel:=0;
 end;
 
 procedure TTiffIDF.Assign(IDF: TTiffIDF);
@@ -214,6 +229,11 @@ begin
   FillOrder:=IDF.FillOrder;
   Orientation:=IDF.Orientation;
   Treshholding:=IDF.Treshholding;
+  RedBits:=IDF.RedBits;
+  GreenBits:=IDF.GreenBits;
+  BlueBits:=IDF.BlueBits;
+  GrayBits:=IDF.GrayBits;
+  AlphaBits:=IDF.AlphaBits;
   if (Img<>nil) and (IDF.Img<>nil) then
     Img.Assign(IDF.Img);
 end;

packages/fcl-image/src/fpwritetiff.pas

@@ -19,7 +19,7 @@
     Orientation,
 
   ToDo:
-    Compression: packbits, deflate, jpeg, ...
+    Compression: LZW, packbits, deflate, jpeg, ...
     thumbnail
     Planar
     ColorMap
@@ -39,7 +39,7 @@ unit FPWriteTiff;
 interface
 
 uses
-  Math, Classes, SysUtils, FPimage, FPTiffCmn, FPWriteTGA;
+  Math, Classes, SysUtils, FPimage, FPTiffCmn;
 
 type
 
@@ -77,6 +77,7 @@ type
 
   TFPWriterTiff = class(TFPCustomImageWriter)
   private
+    FSaveCMYKAsRGB: boolean;
     fStartPos: Int64;
     FEntries: TFPList; // list of TFPList of TTiffWriteEntry
     fStream: TStream;
@@ -108,6 +109,7 @@ type
     procedure Clear;
     procedure AddImage(Img: TFPCustomImage);
     procedure SaveToStream(Stream: TStream);
+    property SaveCMYKAsRGB: boolean read FSaveCMYKAsRGB write FSaveCMYKAsRGB;
   end;
 
 function CompareTiffWriteEntries(Entry1, Entry2: Pointer): integer;
@@ -315,9 +317,15 @@ begin
     CurEntries:=TFPList.Create;
     FEntries.Add(CurEntries);
 
-    IDF.PhotoMetricInterpretation:=StrToInt64Def(Img.Extra[TiffPhotoMetric],High(IDF.PhotoMetricInterpretation));
+    if Img.Extra[TiffPhotoMetric]='' then
+      IDF.PhotoMetricInterpretation:=2
+    else begin
+      IDF.PhotoMetricInterpretation:=StrToInt64Def(Img.Extra[TiffPhotoMetric],High(IDF.PhotoMetricInterpretation));
+      if SaveCMYKAsRGB and (IDF.PhotoMetricInterpretation=5) then
+        IDF.PhotoMetricInterpretation:=2;
+    end;
     if not (IDF.PhotoMetricInterpretation in [0,1,2]) then
-      TiffError('PhotoMetricInterpretation='+IntToStr(IDF.PhotometricInterpretation)+' not supported');
+      TiffError('PhotoMetricInterpretation="'+Img.Extra[TiffPhotoMetric]+'" not supported');
     IDF.Artist:=Img.Extra[TiffArtist];
     IDF.Copyright:=Img.Extra[TiffCopyright];
     IDF.DocumentName:=Img.Extra[TiffDocumentName];
@@ -329,14 +337,14 @@ begin
     IDF.ResolutionUnit:=StrToIntDef(Img.Extra[TiffResolutionUnit],2);
     if not (IDF.ResolutionUnit in [1..3]) then
       IDF.ResolutionUnit:=2;
-    IDF.XResolution:=StrToTiffRationalDef(Img.Extra[TiffXResolution],TiffRational0);
-    IDF.YResolution:=StrToTiffRationalDef(Img.Extra[TiffYResolution],TiffRational0);
-
-    GrayBits:=StrToIntDef(Img.Extra[TiffGrayBits],0);
-    RedBits:=StrToIntDef(Img.Extra[TiffRedBits],0);
-    GreenBits:=StrToIntDef(Img.Extra[TiffGreenBits],0);
-    BlueBits:=StrToIntDef(Img.Extra[TiffBlueBits],0);
-    AlphaBits:=StrToIntDef(Img.Extra[TiffAlphaBits],0);
+    IDF.XResolution:=StrToTiffRationalDef(Img.Extra[TiffXResolution],TiffRational72);
+    IDF.YResolution:=StrToTiffRationalDef(Img.Extra[TiffYResolution],TiffRational72);
+
+    GrayBits:=StrToIntDef(Img.Extra[TiffGrayBits],8);
+    RedBits:=StrToIntDef(Img.Extra[TiffRedBits],8);
+    GreenBits:=StrToIntDef(Img.Extra[TiffGreenBits],8);
+    BlueBits:=StrToIntDef(Img.Extra[TiffBlueBits],8);
+    AlphaBits:=StrToIntDef(Img.Extra[TiffAlphaBits],8);
     ImgWidth:=Img.Width;
     ImgHeight:=Img.Height;
     Compression:=1;
@@ -612,6 +620,7 @@ constructor TFPWriterTiff.Create;
 begin
   inherited Create;
   FEntries:=TFPList.Create;
+  FSaveCMYKAsRGB:=true;
 end;
 
 destructor TFPWriterTiff.Destroy;

packages/fv/src/colorsel.pas

@@ -0,0 +1,204 @@
+{
+
+   (Still unused) skeleton for Colorsel replacement, based on mostly the 
+     use by the fpmopts.inc file, to be added on as details emerge.
+
+   Copyright 2008 by Marco van de Voort
+
+   This library is free software; you can redistribute it and/or
+   modify it under the terms of the GNU Library General Public
+   License as published by the Free Software Foundation; either
+   version 2 of the License, or (at your option) any later version.
+
+   This library 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
+   Library General Public License for more details.
+
+   You should have received a copy of the GNU Library General Public
+   License along with this library; if not, write to the Free
+   Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************}
+
+unit Colorsel;
+
+interface
+
+Uses Objects,Dialogs;
+
+Type
+    PColorItem  = ^TColorItem;
+    TColorItem  = Record
+                    Next : PColorItem;
+                    Name : PString;
+            		    Index: Longint;
+                    end;
+
+    PColorGroup = ^TColorGroup;
+    TColorGroup = Record
+            		    Next  : PColorGroup;
+            		    Name  : PString;
+            		    Index : Longint;
+            		    Items : PColorItem;
+                	  end;
+
+    PColorDialog = ^TColorDialog;
+    TColorDialog = object(TDialog)
+                       constructor Init(APalette:integer;colGroup:PColorGroup);  //
+                       constructor Load(var S: TStream);
+                       procedure Store(var S: TStream);
+                      end;
+
+function ColorItem(Name:String;Index:integer;Item:PColorItem):PColorItem;
+function ColorGroup(Name:String;item:PColorItem;Group:PColorGroup):PColorGroup;
+
+// function MenuColorItems(p:pointer):PColorItem; ??
+
+procedure RegisterColorSel;
+
+implementation
+
+Uses fvconsts; // idcolordialog
+
+function ColorItem(Name:String;index:integer;Item:PColorItem):PColorItem;
+
+var p : PColorItem;
+begin
+  new(p);
+  new(p^.Name);
+  p^.Name^:=Name;
+  p^.index:=index;
+  p^.next:=item;
+  ColorItem:=p;
+end;
+
+function ColorGroup(Name:String;item:PColorItem;Group:PColorGroup):PColorGroup;
+var p : PColorGroup;
+begin
+  new(p);
+  new(p^.Name);
+  p^.Name^:=Name;
+  p^.next:=group;
+  p^.items:=item;
+  ColorGroup:=p;
+end;
+
+const
+  RColorDialog: TStreamRec = (
+     ObjType: idColorDialog;
+     VmtLink: Ofs(TypeOf(TColorDialog)^);
+     Load:    @TColorDialog.Load;
+     Store:   @TColorDialog.Store
+  );
+
+
+procedure RegisterColorsel;
+begin
+ // according to help should register TColorSelector,     TMonoSelector, TColorDisplay, TColorGroupList, TColorItemList,     TColorDialog
+ // probably don't bother with the mono variants. Except for (P/T)colordialog, these don't grep in FV/IDE src.
+
+ // TColorSelector -> the square colorselection widget (instantiated twice once for front, once for back?)
+ // TColorGrouplist-> the selection of the color group (left list)  (TListbox or whatever the TV eq is?)
+ // TColorItemList -> the selection of the color identifier (right list)  (TListbox or whatever the TV eq is?)
+
+ RegisterType(RColorDialog);
+end ;
+
+
+constructor TColorDialog.Init(APalette:integer;colGroup:PColorGroup);
+begin
+end;
+constructor TColorDialog.Load(var S: TStream);
+begin
+end;
+procedure TColorDialog.Store(var S: TStream);
+begin
+end;
+
+end.
+
+{
+
+
+ ColorGroup(label_colors_grp_menus,   MenuColorItems(nil),
+    ColorGroup(label_colors_grp_desktop, DesktopColorItems(nil),
+    ColorGroup(label_colors_grp_dialogs, DialogColorItems(dpGrayDialog,nil),
+
+
+ from fpmopts.inc
+procedure TIDEApp.Colors;
+
+var D: PColorDialog;
+begin
+  New(D, Init(AppPalette,
+    ColorGroup(label_colors_grp_browser,
+      ColorItem(label_colors_framepassive   , 215,
+      ColorItem(label_colors_frameactive    , 216,
+      ColorItem(label_colors_frameicon      , 217,
+      ColorItem(label_colors_scrollbarpage  , 218,
+      ColorItem(label_colors_scrollbaricons , 219,
+      ColorItem(label_colors_normaltext     , 220,
+      ColorItem(label_colors_selectedtext   , 221,
+      ColorItem(label_colors_activeitem     , 222,
+      ColorItem(label_colors_inactiveitem   , 223,
+      ColorItem(label_colors_focuseditem    , 224,
+      ColorItem(label_colors_selecteditem   , 225,
+      ColorItem(label_colors_divider        , 226,
+      nil)))))))))))),
+    ColorGroup(label_colors_grp_clock,
+      ColorItem(label_colors_clockview      , 227,
+      nil),
+    ColorGroup(label_colors_grp_menus,   MenuColorItems(nil),
+    ColorGroup(label_colors_grp_desktop, DesktopColorItems(nil),
+    ColorGroup(label_colors_grp_dialogs, DialogColorItems(dpGrayDialog,nil),
+    ColorGroup(label_colors_grp_editor,
+      ColorItem(label_colors_framepassive   , 167,
+      ColorItem(label_colors_frameactive    , 168,
+      ColorItem(label_colors_frameicon      , 169,
+      ColorItem(label_colors_scrollbarpage  , 170,
+      ColorItem(label_colors_scrollbaricons , 171,
+      ColorItem(label_colors_normaltext     , 199,
+      ColorItem(label_colors_selectedtext   , 208,
+      ColorItem(label_colors_highlighcolumn , 209,
+      ColorItem(label_colors_highlightrow   , 210,
+      ColorItem(label_colors_errormessages  , 214,
+      nil)))))))))),
+    ColorGroup(label_colors_grp_help,
+      ColorItem(label_colors_framepassive   , 128,
+      ColorItem(label_colors_frameactive    , 129,
+      ColorItem(label_colors_frameicon      , 130,
+      ColorItem(label_colors_scrollbarpage  , 131,
+      ColorItem(label_colors_scrollbaricons , 132,
+      ColorItem(label_colors_helptext       , 160,
+      ColorItem(label_colors_helplinks      , 161,
+      ColorItem(label_colors_selectedlink   , 162,
+      ColorItem(label_colors_selectedtext   , 163,
+      ColorItem(label_colors_html_heading1  , 229,
+      ColorItem(label_colors_html_heading2  , 230,
+      ColorItem(label_colors_html_heading3  , 231,
+      ColorItem(label_colors_html_heading4  , 232,
+      ColorItem(label_colors_html_heading5  , 233,
+      ColorItem(label_colors_html_heading6  , 234,
+      nil))))))))))))))),
+    ColorGroup(label_colors_grp_menus,   MenuColorItems(nil),
+    ColorGroup(label_colors_grp_syntax,
+      ColorItem(label_colors_whitespace      , 200,
+      ColorItem(label_colors_comments        , 201,
+      ColorItem(label_colors_reservedwords   , 202,
+      ColorItem(label_colors_identifiers     , 203,
+      ColorItem(label_colors_strings         , 204,
+      ColorItem(label_colors_numbers         , 205,
+      ColorItem(label_colors_hexnumbers      , 212,
+      ColorItem(label_colors_assembler       , 206,
+      ColorItem(label_colors_symbols         , 207,
+      ColorItem(label_colors_directives      , 211,
+      ColorItem(label_colors_tabs            , 213,
+      nil))))))))))),
+    nil))))))))));
+end;
+
+fvconsts.pas:  idColorSelector = 92;
+fvconsts.pas:  idMonoSelector = 93;
+
+}

packages/mysql/src/mysql.inc

@@ -1486,8 +1486,8 @@ uses
 {$endif}
 
 {$IFDEF LinkDynamically}
-Function InitialiseMysql(Const LibraryName : String) : Integer;
-Function InitialiseMysql : Integer;
+Function InitialiseMysql(Const LibraryName : String; argc:cint = 0; argv:PPchar = nil; groups:PPchar = nil) : Integer;
+Function InitialiseMysql(argc:cint = 0; argv:PPchar = nil; groups:PPchar = nil) : Integer;
 Procedure ReleaseMysql;
 
 var MysqlLibraryHandle : TLibHandle;
@@ -1506,7 +1506,7 @@ var
   RefCount : integer;
   LoadedLibrary : String;
 
-Function TryInitialiseMysql(Const LibraryName : String) : Integer;
+Function TryInitialiseMysql(Const LibraryName : String; argc:cint = 0; argv:PPchar = nil; groups:PPchar = nil) : Integer;
 
 
 begin
@@ -1619,26 +1619,28 @@ begin
     pointer(mysql_stmt_affected_rows) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_affected_rows');
     pointer(mysql_stmt_insert_id) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_insert_id');
     pointer(mysql_stmt_field_count) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_field_count');
+
+    mysql_library_init(0,nil,nil);
     end
   else
     inc(RefCount);
   Result:=RefCount;
 end;
 
-Function InitialiseMysql : Integer;
+Function InitialiseMysql(argc:cint = 0; argv:PPchar = nil; groups:PPchar = nil) : Integer;
 
 begin
   Result := 0;
-  If (TryInitialiseMysql(mysqlvlib) = 0) and
-     (TryInitialiseMysql(mysqllib) = 0) then
+  If (TryInitialiseMysql(mysqlvlib,argc,argv,groups) = 0) and
+     (TryInitialiseMysql(mysqllib,argc,argv,groups) = 0) then
       Raise EInOutError.CreateFmt(SErrDefaultsFailed,[mysqlvlib,mysqllib]);
   Result := RefCount;
 end;
 
-Function InitialiseMysql(Const LibraryName : String) : Integer;
+Function InitialiseMysql(Const LibraryName : String; argc:cint = 0; argv:PPchar = nil; groups:PPchar = nil) : Integer;
 
 begin
-  Result := TryInitialiseMysql(LibraryName);
+  Result := TryInitialiseMysql(LibraryName,argc,argv,groups);
   If Result = 0 then
     Raise EInOutError.CreateFmt(SErrLoadFailed,[LibraryName])
   else If (LibraryName<>LoadedLibrary) then
@@ -1654,12 +1656,16 @@ Procedure ReleaseMysql;
 begin
   if RefCount> 1 then
     Dec(RefCount)
-  else if UnloadLibrary(MysqlLibraryHandle) then 
+  else if RefCount = 1 then
     begin
-    Dec(RefCount);
-    MysqlLibraryHandle := NilHandle;
-    LoadedLibrary:='';
-    end;
+    mysql_library_end;
+    if UnloadLibrary(MysqlLibraryHandle) then
+      begin
+      Dec(RefCount);
+      MysqlLibraryHandle := NilHandle;
+      LoadedLibrary:='';
+      end
+    end
 end;
 
 {$ENDIF}
@@ -1715,5 +1721,8 @@ end;
       result := -1;
     end;
 
-
+{$IFDEF LinkDynamically}
+initialization
+  Refcount := 0;
+{$ENDIF}
 end.

packages/odbc/src/odbcsql.inc

@@ -22,16 +22,14 @@
 interface
 
 uses
-{$IFDEF DYNLOADINGODBC}
      Dynlibs,
-{$ENDIF}
      ctypes,
      sysutils;
 
 {$IFDEF Unix}
   {$DEFINE extdecl:=cdecl}
   const
-    odbclib = 'libodbc.so';
+    odbclib = 'libodbc.'+sharedsuffix;
 {$ENDIF}
 {$IFDEF Windows}
   {$DEFINE extdecl:=stdcall}

packages/postgres/src/postgres3dyn.pp

@@ -12,11 +12,11 @@ unit postgres3dyn;
 interface
 
 uses
-  dynlibs, SysUtils, dllistdyn;
+  dynlibs, SysUtils, dllistdyn, ctypes;
 
 {$IFDEF Unix}
   const
-    pqlib = 'libpq.so';
+    pqlib = 'libpq.'+sharedsuffix;
 {$ENDIF}
 {$IFDEF Win32}
   const

packages/sqlite/src/sqlite3.inc

@@ -7,9 +7,11 @@
 
 interface
 
+uses
 {$ifdef LOAD_DYNAMICALLY}
-uses 
   SysUtils, DynLibs;
+{$else}
+  DynLibs;
 {$endif}
 
 {
@@ -28,7 +30,7 @@ const
 {$IFDEF WINDOWS}
   Sqlite3Lib = 'sqlite3.dll';
 {$else}
-  Sqlite3Lib = 'libsqlite3.so';
+  Sqlite3Lib = 'libsqlite3.'+sharedsuffix;
 {$endif}
 
   SQLITE_INTEGER = 1;   

packages/unzip/src/unzip.pp

@@ -2225,7 +2225,7 @@ FUNCTION unzipfile ( in_name : pchar;out_name : pchar;offset : longint;
   hFileAction : word;cm_index : integer ) : integer;
 VAR err : integer;
     header : plocalheader;
-    buf : ARRAY [ 0..80 ] of char;
+    buf : ARRAY [ 0..tfSize+1 ] of char;
 {$ifndef unix}
     buf0 : ARRAY [ 0..3 ] of char;
 {$endif}

rtl/linux/linux.pp

@@ -478,18 +478,23 @@ end;
 
 function sync_file_range(fd: cInt; offset: off64_t; nbytes: off64_t; flags: cuInt): cInt;
 begin
-{$ifdef cpu64}
-  sync_file_range := do_syscall(syscall_nr_sync_file_range, TSysParam(fd), TSysParam(offset), 
-    TSysParam(nbytes), TSysParam(flags));
-{$else}
 {$if defined(cpupowerpc) or defined(cpuarm)}
   sync_file_range := do_syscall(syscall_nr_sync_file_range2, TSysParam(fd), TSysParam(flags), 
     TSysParam(hi(offset)), TSysParam(lo(offset)), TSysParam(hi(nbytes)), TSysParam(lo(nbytes)));
+{$else}
+{$if defined(cpupowerpc64)}
+  sync_file_range := do_syscall(syscall_nr_sync_file_range2, TSysParam(fd), TSysParam(flags),
+    TSysParam(offset), TSysParam(nbytes));
+{$else}
+{$ifdef cpu64}
+  sync_file_range := do_syscall(syscall_nr_sync_file_range, TSysParam(fd), TSysParam(offset), 
+    TSysParam(nbytes), TSysParam(flags));
 {$else}
   sync_file_range := do_syscall(syscall_nr_sync_file_range, TSysParam(fd), TSysParam(lo(offset)),
     TSysParam(hi(offset)), TSysParam(lo(nbytes)), TSysParam(hi(nbytes)), TSysParam(flags));
 {$endif}
 {$endif}
+{$endif}
 end;
 
 function fdatasync (fd: cint): cint;

rtl/objpas/sysutils/sysstr.inc

@@ -2016,7 +2016,6 @@ Var
         Else
           Digits[DecimalPoint-1]:=' ';
         End;
-
       { Convert optional zeroes to spaces. }
       I:=len;
       J:=DecimalPoint+Placehold[3];
@@ -2031,17 +2030,23 @@ Var
           Digits[DecimalPoint] := ' ';
       { Convert spaces left from obligatory decimal point to zeroes. }
       I:=DecimalPoint-Placehold[2];
-      If (Value<0) and (I<DecimalPoint) and (Digits[1]<>'-') then
-        begin
-        Insert('-',Digits,I);
-        Inc(DecimalPoint);
-        Inc(I);
-        end;
-      While (I<DecimalPoint) And (Digits[I] in [' ','-']) Do
+      While (I<DecimalPoint) And (Digits[I] in [' ']) Do
         Begin
         Digits[I] := '0';
         Inc(I);
         End;
+      { Convert zeroes left from minus sign to spaces}  
+      // Search minus sign
+      I:=DecimalPoint;
+      While (I>0) and (Digits[i]<>'-') do
+        Dec(i);
+      // Now convert  
+      Dec(I);
+      While (I>0) and (Digits[i]='0') do
+        begin
+        Digits[I] := ' ';
+        Inc(I);
+        end;
       Exp := 0;
       End
     Else

rtl/objpas/varutils.inc

@@ -391,27 +391,27 @@ Const
      ARR_OLESTR,ARR_DISPATCH,ARR_NONE,ARR_NONE,ARR_VARIANT,ARR_UNKNOWN,
      ARR_NONE,ARR_NONE,ARR_NONE,ARR_NONE,ARR_NONE,ARR_NONE,ARR_NONE,ARR_NONE);
   psaElementSizes : Array [varEmpty..varQWord] of Byte =
-    (0,0,
-     SizeOf(SmallInt),
-     SizeOf(Integer),
-     SizeOf(Single),
-     SizeOf(Double),
-     0, // unused
-     SizeOf(TDateTime),
-     SizeOf(Currency),
-     SizeOf(PWideString),
-     SizeOf(IInterface),
-     SizeOf(TError),
-     SizeOf(Boolean),
-     SizeOf(TVarData),
-     SizeOf(IUnknown),
-     0, // Decimal
-     SizeOf(ShortInt),
-     SizeOf(Byte),
-     SizeOf(Word),
-     SizeOf(LongWord),
-     SizeOf(Int64),
-     SizeOf(QWord));
+    (0,0,                  // varempty, varnull
+     SizeOf(SmallInt),     // varsmallint
+     SizeOf(Integer),      // varinteger
+     SizeOf(Single),       // varsingle
+     SizeOf(Double),       // vardouble
+     SizeOf(Currency),     // varcurrency
+     SizeOf(TDateTime),    // vardate
+     SizeOf(PWideString),  // varolestr
+     SizeOf(IInterface),   // vardispatch
+     SizeOf(TError),       // varerror
+     SizeOf(Boolean),      // varboolean
+     SizeOf(TVarData),     // varvariant
+     SizeOf(IUnknown),     // varunknown
+     0, // Decimal         // vardecimal
+     0, // Unused
+     SizeOf(ShortInt),     // varshortint
+     SizeOf(Byte),         // varbyte
+     SizeOf(Word),         // varword
+     SizeOf(LongWord),     // varlongword
+     SizeOf(Int64),        // varint64
+     SizeOf(QWord));       // varqword
 
 Function SafeArrayCreate(VarType, Dim: DWord; const Bounds: TVarArrayBoundArray): PVarArray;stdcall;
   var

rtl/unix/sysutils.pp

@@ -866,7 +866,6 @@ begin
 end;
 
 
-{$define FPC_USE_FPEXEC}  // leave the old code under IFDEF for a while.
 function ExecuteProcess(Const Path: AnsiString; Const ComLine: AnsiString):integer;
 var
   pid    : longint;
@@ -879,7 +878,8 @@ Begin
     so that long filenames will always be accepted. But don't
     do it if there are already double quotes!
   }
-  {$ifdef FPC_USE_FPEXEC}       // Only place we still parse
+
+   // Only place we still parse
    cmdline2:=nil;
    if Comline<>'' Then
      begin
@@ -896,14 +896,7 @@ Begin
        cmdline2^:=pchar(Path);
        cmdline2[1]:=nil;
      end;
-  {$else}
-  if Pos ('"', Path) = 0 then
-    CommandLine := '"' + Path + '"'
-  else
-    CommandLine := Path;
-  if ComLine <> '' then
-    CommandLine := Commandline + ' ' + ComLine;
-  {$endif}
+
   {$ifdef USE_VFORK}
   pid:=fpvFork;
   {$else USE_VFORK}
@@ -912,11 +905,7 @@ Begin
   if pid=0 then
    begin
    {The child does the actual exec, and then exits}
-    {$ifdef FPC_USE_FPEXEC}
       fpexecv(pchar(pointer(Path)),Cmdline2);
-    {$else}
-      Execl(CommandLine);
-    {$endif}
      { If the execve fails, we return an exitvalue of 127, to let it be known}
      fpExit(127);
    end
@@ -931,10 +920,8 @@ Begin
   { We're in the parent, let's wait. }
   result:=WaitProcess(pid); // WaitPid and result-convert
 
-  {$ifdef FPC_USE_FPEXEC}
   if Comline<>'' Then
     freemem(cmdline2);
-  {$endif}
 
   if (result<0) or (result=127) then
     begin

rtl/win32/sysinitgprof.pp

@@ -171,10 +171,11 @@ unit sysinitgprof;
       end;
 
 {$warnings off}
+    {$linklib c}
     {$linklib gmon}
-    {$linklib gcc}
     {$linklib cygwin}
     {$linklib user32}
     {$linklib kernel32}
+    {$linklib gcc}
 
 end.

tests/Makefile

@@ -1,5 +1,5 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2008/09/28]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2008/11/23]
 #
 default: allexectests
 MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded avr-embedded armeb-linux armeb-embedded
@@ -1443,7 +1443,7 @@ ifndef LOG
 export LOG:=$(TEST_OUTPUTDIR)/log
 endif
 TESTSUBDIRS=cg cg/variants cg/cdecl opt units/system units/dos units/crt units/objects units/strings units/sysutils units/math units/sharemem
-TESTPACKAGESUBDIRS=cg packages/win-base packages/webtbs packages/hash packages/fcl-registry packages/fcl-process packages/zlib
+TESTPACKAGESUBDIRS=cg packages/win-base packages/webtbs packages/hash packages/fcl-registry packages/fcl-process packages/zlib packages/fcl-db
 ifdef QUICKTEST
 export QUICKTEST
 else

tests/Makefile.fpc

@@ -120,7 +120,7 @@ endif
 
 # Subdirs available in the test subdir
 TESTSUBDIRS=cg cg/variants cg/cdecl opt units/system units/dos units/crt units/objects units/strings units/sysutils units/math units/sharemem
-TESTPACKAGESUBDIRS=cg packages/win-base packages/webtbs packages/hash packages/fcl-registry packages/fcl-process packages/zlib
+TESTPACKAGESUBDIRS=cg packages/win-base packages/webtbs packages/hash packages/fcl-registry packages/fcl-process packages/zlib packages/fcl-db packages/fcl-base
 
 ifdef QUICKTEST
 export QUICKTEST

tests/test/packages/fcl-base/tgettext1.pp

@@ -0,0 +1,10 @@
+{ gettext was crashing under Windows CE. Not crashing should be considered a success }
+
+uses gettext;
+
+var
+  LangDefault, LangFallback: ansistring;
+begin
+  GetLanguageIDs(LangDefault, LangFallback);
+end.
+

tests/test/packages/fcl-db/assertions.pas

@@ -0,0 +1,32 @@
+unit Assertions;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils; 
+
+procedure AssertTrue(v1 : boolean);
+procedure AssertEquals(v1,v2 : string); overload;
+procedure AssertEquals(v1,v2 : integer); overload;
+
+implementation
+
+procedure AssertTrue(v1: boolean);
+begin
+  if not v1 then halt(1);
+end;
+
+procedure AssertEquals(v1, v2: string);
+begin
+  AssertTrue(v1=v2);
+end;
+
+procedure AssertEquals(v1, v2: integer);
+begin
+  AssertTrue(v1=v2);
+end;
+
+end.
+

tests/test/packages/fcl-db/dbftoolsunit.pas

@@ -0,0 +1 @@
+{$i ../../../../packages/fcl-db/tests/dbftoolsunit.pas}

tests/test/packages/fcl-db/tdb1.pp

@@ -0,0 +1,45 @@
+program TTestDBBasics_TestGetFieldValues;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, SysUtils,
+  Assertions,
+  ToolsUnit,
+  dbftoolsunit,
+  db;
+
+var AVar          : Variant;
+    PassException : boolean;
+
+begin
+  DBConnectorName := 'dbf';
+  InitialiseDBConnector;
+  with DBConnector.GetNDataset(true,14) do
+    begin
+    open;
+    AVar:=FieldValues['id'];
+    AssertEquals(AVar,1);
+
+    AVar:=FieldValues['name'];
+    AssertEquals(AVar,'TestName1');
+
+    AVar:=FieldValues['id;name'];
+    AssertEquals(AVar[0],1);
+    AssertEquals(AVar[1],'TestName1');
+
+    AVar:=FieldValues['name;id;'];
+    AssertEquals(AVar[1],1);
+    AssertEquals(AVar[0],'TestName1');
+
+    PassException:=false;
+    try
+      AVar:=FieldValues['name;id;fake'];
+    except
+      on E: EDatabaseError do PassException := True;
+    end;
+    AssertTrue(PassException);
+
+    end;
+end.
+

tests/test/packages/fcl-db/tdb2.pp

@@ -0,0 +1,48 @@
+program TTestDBBasics_TestSetFieldValues;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, SysUtils,
+  Assertions,
+  ToolsUnit,
+  dbftoolsunit,
+  variants,
+  db;
+
+var PassException : boolean;
+
+begin
+  DBConnectorName := 'dbf';
+  InitialiseDBConnector;
+  with DBConnector.GetNDataset(true,11) do
+    begin
+    open;
+    first;
+    edit;
+    FieldValues['id']:=5;
+    post;
+    AssertEquals('TestName1',FieldByName('name').AsString);
+    AssertEquals(5,FieldByName('id').AsInteger);
+    edit;
+    FieldValues['name']:='FieldValuesTestName';
+    post;
+    AssertEquals('FieldValuesTestName',FieldByName('name').AsString);
+    AssertEquals(5,FieldByName('id').AsInteger);
+    edit;
+    FieldValues['id;name']:= VarArrayOf([243,'ValuesTestName']);
+    post;
+    AssertEquals('ValuesTestName',FieldByName('name').AsString);
+    AssertEquals(243,FieldByName('id').AsInteger);
+    
+    PassException:=false;
+    try
+      edit;
+      FieldValues['id;name;fake']:= VarArrayOf([243,'ValuesTestName',4]);
+    except
+      on E: EDatabaseError do PassException := True;
+    end;
+    post;
+    AssertTrue(PassException);
+    end;
+end.

tests/test/packages/fcl-db/toolsunit.pas

@@ -0,0 +1 @@
+{$i ../../../../packages/fcl-db/tests/toolsunit.pas}

utils/fpdoc/dw_htmlchm.inc

@@ -179,12 +179,12 @@ begin
         // by unit
         TmpItem := ObjUnitItem.Children.NewItem;
         TmpItem.Text := Element.Name;
-        TmpItem.Local := Allocator.GetFilename(Element, 0);
+        TmpItem.Local := FixHTMLpath(Allocator.GetFilename(Element, 0));
         
         //alpha
         TmpItem := GetAlphaItem(AlphaObjItem.Children, UpperCase(Copy(Element.Name, 1, 2))).Children.NewItem;
         TmpItem.Text := Element.Name;
-        TmpItem.Local := Allocator.GetFilename(Element, 0);
+        TmpItem.Local := FixHTMLpath(Allocator.GetFilename(Element, 0));
         
       end;
       
@@ -195,12 +195,12 @@ begin
         // by unit
         TmpItem := RoutinesUnitItem.Children.NewItem;
         TmpItem.Text := Element.Name;
-        TmpItem.Local := Allocator.GetFilename(Element, 0);
+        TmpItem.Local := FixHTMLpath(Allocator.GetFilename(Element, 0));
         
         // alpha
         TmpItem := GetAlphaItem(AlphaRoutinesItem.Children, UpperCase(Element.Name[1])).Children.NewItem;
         TmpItem.Text := Element.Name;
-        TmpItem.Local := Allocator.GetFilename(Element, 0);
+        TmpItem.Local := FixHTMLpath(Allocator.GetFilename(Element, 0));
       end;
     end;
   end;
@@ -287,7 +287,7 @@ begin
       AModule := TPasModule(Package.Modules[i]);
       ParentItem := Index.Items.NewItem;
       ParentItem.Text := AModule.Name;
-      ParentItem.Local := Allocator.GetFilename(AModule, 0);
+      ParentItem.Local := FixHTMLpath(Allocator.GetFilename(AModule, 0));
 
       //  classes
       for j := 0 to AModule.InterfaceSection.Classes.Count-1 do
@@ -295,7 +295,7 @@ begin
         ParentElement := TPasClassType(AModule.InterfaceSection.Classes[j]);
         ParentItem := Index.Items.NewItem;
         ParentItem.Text := ParentELement.Name;
-        ParentItem.Local := Allocator.GetFilename(ParentElement, 0);
+        ParentItem.Local := FixHTMLpath(Allocator.GetFilename(ParentElement, 0));
         for k := 0 to TPasClassType(ParentElement).Members.Count-1 do
         begin
           TmpElement := TPasElement(TPasClassType(ParentElement).Members.Items[k]);
@@ -314,7 +314,7 @@ begin
             cmtInterface   : TmpItem.Text := TmpElement.Name + ' interface';
             cmtUnknown     : TmpItem.Text := TmpElement.Name;
           end;
-          TmpItem.Local := Allocator.GetFilename(TmpElement, 0);
+          TmpItem.Local := FixHTMLpath(Allocator.GetFilename(TmpElement, 0));
           {
           ParentElement = Class
              TmpElement = Member
@@ -322,11 +322,11 @@ begin
           MemberItem := nil;
           MemberItem := GetAlphaItem(Index.Items, TmpElement.Name);
           // ahh! if MemberItem.Local is empty MemberType is not shown!
-          MemberItem.Local := Allocator.GetFilename(TmpElement, 0);
+          MemberItem.Local := FixHTMLpath(Allocator.GetFilename(TmpElement, 0));
 
           TmpItem := MemberItem.Children.NewItem;
           TmpItem.Text := ParentElement.Name;
-          TmpITem.Local := Allocator.GetFilename(TmpElement, 0);
+          TmpITem.Local := FixHTMLpath(Allocator.GetFilename(TmpElement, 0));
         end;
       end;
       // routines
@@ -335,7 +335,7 @@ begin
         ParentElement := TPasProcedureType(AModule.InterfaceSection.Functions[j]);
         TmpItem := Index.Items.NewItem;
         TmpItem.Text := ParentElement.Name + ' ' + TPasFunction(ParentElement).ElementTypeName;
-        TmpItem.Local := Allocator.GetFilename(ParentElement, 0);
+        TmpItem.Local := FixHTMLpath(Allocator.GetFilename(ParentElement, 0));
       end;
       // consts
       for j := 0 to AModule.InterfaceSection.Consts.Count-1 do
@@ -343,7 +343,7 @@ begin
         ParentElement := TPasElement(AModule.InterfaceSection.Consts[j]);
         TmpItem := Index.Items.NewItem;
         TmpItem.Text := ParentElement.Name;
-        TmpItem.Local := Allocator.GetFilename(ParentElement, 0);
+        TmpItem.Local := FixHTMLpath(Allocator.GetFilename(ParentElement, 0));
       end;
       // types
       for j := 0 to AModule.InterfaceSection.Types.Count-1 do
@@ -351,7 +351,7 @@ begin
         ParentElement := TPasType(AModule.InterfaceSection.Types[j]);
         TmpItem := Index.Items.NewItem;
         TmpItem.Text := ParentElement.Name;
-        TmpItem.Local := Allocator.GetFilename(ParentElement, 0);
+        TmpItem.Local := FixHTMLpath(Allocator.GetFilename(ParentElement, 0));
         // enums
         if ParentELement is TPasEnumType then
         begin
@@ -376,7 +376,7 @@ begin
         ParentElement := TPasElement(AModule.InterfaceSection.Variables[j]);
         TmpItem := Index.Items.NewItem;
         TmpItem.Text := ParentElement.Name + ' var';
-        TmpItem.Local := Allocator.GetFilename(ParentElement, 0);
+        TmpItem.Local := FixHTMLpath(Allocator.GetFilename(ParentElement, 0));
       end;
       // declarations
       {
@@ -385,7 +385,7 @@ begin
         ParentElement := TPasElement(AModule.InterfaceSection.Declarations[j]);
         TmpItem := Index.Items.NewItem;
         TmpItem.Text := ParentElement.Name;
-        TmpItem.Local := Allocator.GetFilename(ParentElement, 0);
+        TmpItem.Local := FixHTMLpath(Allocator.GetFilename(ParentElement, 0));
       end;
       // resource strings
       for j := 0 to AModule.InterfaceSection.ResStrings.Count-1 do
@@ -393,7 +393,7 @@ begin
         ParentElement := TPasElement(AModule.InterfaceSection.ResStrings[j]);
         TmpItem := Index.Items.NewItem;
         TmpItem.Text := ParentElement.Name;
-        TmpItem.Local := Allocator.GetFilename(ParentElement, 0);
+        TmpItem.Local := FixHTMLpath(Allocator.GetFilename(ParentElement, 0));
       end;
       }
     end;