Browse Source

--- Merging r16857 into '.':
U packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp
--- Merging r16882 into '.':
U packages/fcl-db/tests/testfieldtypes.pas
U packages/fcl-db/tests/sqldbtoolsunit.pas
--- Merging r16883 into '.':
U packages/fcl-db/tests/toolsunit.pas
U packages/fcl-db/tests/dbtestframework.pas
U packages/fcl-db/tests/testdbbasics.pas
U packages/fcl-db/tests/dbftoolsunit.pas
U packages/fcl-db/tests/sqldbtoolsunit.pas
--- Merging r16948 into '.':
U packages/fcl-db/tests/dbtestframework.pas
U packages/fcl-db/tests/testdbbasics.pas
G packages/fcl-db/tests/sqldbtoolsunit.pas
G packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp
U packages/fcl-db/src/base/dataset.inc
U packages/fcl-db/src/base/bufdataset.pas
U packages/fcl-db/src/base/db.pas
U packages/fcl-db/src/base/fields.inc
--- Merging r16954 into '.':
U packages/fcl-db/tests/toolsunit.pas
G packages/fcl-db/tests/dbtestframework.pas
G packages/fcl-db/tests/testdbbasics.pas
G packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp
--- Merging r16980 into '.':
G packages/fcl-db/src/base/fields.inc
--- Merging r16988 into '.':
U packages/fcl-db/src/sqldb/odbc/odbcconn.pas
--- Merging r17000 into '.':
G packages/fcl-db/tests/toolsunit.pas
G packages/fcl-db/tests/testdbbasics.pas
G packages/fcl-db/tests/sqldbtoolsunit.pas
U packages/odbc/src/odbcsql.inc
--- Merging r17075 into '.':
U packages/fcl-db/src/memds/memds.pp
--- Merging r17076 into '.':
G packages/fcl-db/src/base/fields.inc
--- Merging r17078 into '.':
U packages/fcl-db/src/sqldb/postgres/pqconnection.pp
--- Merging r17179 into '.':
U packages/fcl-db/src/sqldb/mysql/mysql50conn.pas
U packages/fcl-db/src/sqldb/mysql/mysql51conn.pas
U packages/fcl-db/src/sqldb/mysql/mysqlconn.inc
--- Merging r17194 into '.':
G packages/fcl-db/src/base/fields.inc
--- Merging r17195 into '.':
G packages/fcl-db/tests/sqldbtoolsunit.pas
--- Merging r17196 into '.':
G packages/fcl-db/tests/sqldbtoolsunit.pas
--- Merging r17199 into '.':
G packages/fcl-db/src/base/fields.inc
--- Merging r17205 into '.':
G packages/fcl-db/src/sqldb/postgres/pqconnection.pp
--- Merging r17208 into '.':
G packages/odbc/src/odbcsql.inc
--- Merging r17220 into '.':
G packages/fcl-db/src/base/fields.inc
--- Merging r17222 into '.':
G packages/fcl-db/tests/testfieldtypes.pas
--- Merging r17243 into '.':
G packages/fcl-db/src/base/fields.inc

# revisions: 16857,16882,16883,16948,16954,16980,16988,17000,17075,17076,17078,17179,17194,17195,17196,17199,17205,17208,17220,17222,17243
------------------------------------------------------------------------
r16857 | joost | 2011-01-30 22:05:56 +0100 (Sun, 30 Jan 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp

* Patch from Ladislav Karrach to use a field's type-affinity to determine the fieldtype. (Fixes aggregate test)
------------------------------------------------------------------------
------------------------------------------------------------------------
r16882 | joost | 2011-02-06 15:09:12 +0100 (Sun, 06 Feb 2011) | 2 lines
Changed paths:
M /trunk/packages/fcl-db/tests/sqldbtoolsunit.pas
M /trunk/packages/fcl-db/tests/testfieldtypes.pas

* Use 'BIGINT'to test largeintfields by default, bug #18649
* Added TestSQLLargeint test, to check for fields which are defined as 'LARGEINT'
------------------------------------------------------------------------
------------------------------------------------------------------------
r16883 | joost | 2011-02-06 15:10:39 +0100 (Sun, 06 Feb 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-db/tests/dbftoolsunit.pas
M /trunk/packages/fcl-db/tests/dbtestframework.pas
M /trunk/packages/fcl-db/tests/sqldbtoolsunit.pas
M /trunk/packages/fcl-db/tests/testdbbasics.pas
M /trunk/packages/fcl-db/tests/toolsunit.pas

* Set svn-properties
------------------------------------------------------------------------
------------------------------------------------------------------------
r16948 | joost | 2011-02-20 13:31:16 +0100 (Sun, 20 Feb 2011) | 3 lines
Changed paths:
M /trunk/packages/fcl-db/src/base/bufdataset.pas
M /trunk/packages/fcl-db/src/base/dataset.inc
M /trunk/packages/fcl-db/src/base/db.pas
M /trunk/packages/fcl-db/src/base/fields.inc
M /trunk/packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp
M /trunk/packages/fcl-db/tests/dbtestframework.pas
M /trunk/packages/fcl-db/tests/sqldbtoolsunit.pas
M /trunk/packages/fcl-db/tests/testdbbasics.pas

* Accidentally comitted files, trying to apply patch from Ladislav Karrach to
implement TFmtBCD fields, bug #16853. Has to be cleaned up later

------------------------------------------------------------------------
------------------------------------------------------------------------
r16954 | joost | 2011-02-20 19:22:06 +0100 (Sun, 20 Feb 2011) | 2 lines
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp
M /trunk/packages/fcl-db/tests/dbtestframework.pas
M /trunk/packages/fcl-db/tests/testdbbasics.pas
M /trunk/packages/fcl-db/tests/toolsunit.pas

* Fixed support of TFmtBcd fields for sqlite3, bug #16853
* Cleaned up accidentally comitted files in r16948
------------------------------------------------------------------------
------------------------------------------------------------------------
r16980 | joost | 2011-02-22 22:46:41 +0100 (Tue, 22 Feb 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/base/fields.inc

* BCD-Variant support is now implemented, use it.
------------------------------------------------------------------------
------------------------------------------------------------------------
r16988 | joost | 2011-02-23 22:40:37 +0100 (Wed, 23 Feb 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/odbc/odbcconn.pas

* TFieldDef.Size for strings should contain the max. number of bytes in the string, without the trailing zero. Bug #17268
------------------------------------------------------------------------
------------------------------------------------------------------------
r17000 | joost | 2011-02-24 23:15:46 +0100 (Thu, 24 Feb 2011) | 2 lines
Changed paths:
M /trunk/packages/fcl-db/tests/sqldbtoolsunit.pas
M /trunk/packages/fcl-db/tests/testdbbasics.pas
M /trunk/packages/fcl-db/tests/toolsunit.pas
M /trunk/packages/odbc/src/odbcsql.inc

* Added test for ftTime fields
* Fixed problem with ftTime field values that exceed 24 hours (odbc)
------------------------------------------------------------------------
------------------------------------------------------------------------
r17075 | marco | 2011-03-05 01:07:31 +0100 (Sat, 05 Mar 2011) | 2 lines
Changed paths:
M /trunk/packages/fcl-db/src/memds/memds.pp

* fix from mantis 17308 "memds" misses ftFixedChar when cloning a dataset field and ftDateTime when copying data.

------------------------------------------------------------------------
------------------------------------------------------------------------
r17076 | marco | 2011-03-05 01:11:20 +0100 (Sat, 05 Mar 2011) | 2 lines
Changed paths:
M /trunk/packages/fcl-db/src/base/fields.inc

* patch from Paul for further vista/win64 API enhancements (mantis 17958)

------------------------------------------------------------------------
------------------------------------------------------------------------
r17078 | marco | 2011-03-05 01:32:48 +0100 (Sat, 05 Mar 2011) | 2 lines
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/postgres/pqconnection.pp

* fixed minor logic errors in pqconnection that lead to double free (actually pqclear()). Mantis 17784 by Andrew Brunner

------------------------------------------------------------------------
------------------------------------------------------------------------
r17179 | joost | 2011-03-25 19:11:58 +0100 (Fri, 25 Mar 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/mysql/mysql50conn.pas
M /trunk/packages/fcl-db/src/sqldb/mysql/mysql51conn.pas
M /trunk/packages/fcl-db/src/sqldb/mysql/mysqlconn.inc

* Better fix for mantis 17661, see r17077
------------------------------------------------------------------------
------------------------------------------------------------------------
r17194 | joost | 2011-03-27 17:17:17 +0200 (Sun, 27 Mar 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/base/fields.inc

* Use new BcdToStf(f) functions, bug #18988
------------------------------------------------------------------------
------------------------------------------------------------------------
r17195 | joost | 2011-03-27 18:08:55 +0200 (Sun, 27 Mar 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-db/tests/sqldbtoolsunit.pas

* Added mysql51-connection type to testsuite
------------------------------------------------------------------------
------------------------------------------------------------------------
r17196 | joost | 2011-03-27 18:19:36 +0200 (Sun, 27 Mar 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-db/tests/sqldbtoolsunit.pas

* BigInt is already set by default since r16882
------------------------------------------------------------------------
------------------------------------------------------------------------
r17199 | michael | 2011-03-28 11:00:31 +0200 (Mon, 28 Mar 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/base/fields.inc

* Fixed bug #19008
------------------------------------------------------------------------
------------------------------------------------------------------------
r17205 | michael | 2011-03-29 13:15:41 +0200 (Tue, 29 Mar 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/postgres/pqconnection.pp

* Fix for 19018
------------------------------------------------------------------------
------------------------------------------------------------------------
r17208 | michael | 2011-03-30 12:54:21 +0200 (Wed, 30 Mar 2011) | 1 line
Changed paths:
M /trunk/packages/odbc/src/odbcsql.inc

* ODBC library is called odbc32 on windows
------------------------------------------------------------------------
------------------------------------------------------------------------
r17220 | michael | 2011-04-02 12:36:48 +0200 (Sat, 02 Apr 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/base/fields.inc

* Added OnValidate event support (17510)
------------------------------------------------------------------------
------------------------------------------------------------------------
r17222 | michael | 2011-04-02 12:47:00 +0200 (Sat, 02 Apr 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-db/tests/testfieldtypes.pas

* Fixed some tests for firebird
------------------------------------------------------------------------
------------------------------------------------------------------------
r17243 | michael | 2011-04-04 15:22:29 +0200 (Mon, 04 Apr 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/base/fields.inc

* ONChange removed from field, TDatset Descendents must do it
------------------------------------------------------------------------

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

marco 14 years ago
parent
commit
b2d56cd45e

+ 5 - 5
.gitattributes

@@ -1349,18 +1349,18 @@ packages/fcl-db/tests/Makefile -text
 packages/fcl-db/tests/Makefile.fpc -text
 packages/fcl-db/tests/Makefile.fpc -text
 packages/fcl-db/tests/README.txt svneol=native#text/plain
 packages/fcl-db/tests/README.txt svneol=native#text/plain
 packages/fcl-db/tests/database.ini.txt svneol=native#text/plain
 packages/fcl-db/tests/database.ini.txt svneol=native#text/plain
-packages/fcl-db/tests/dbftoolsunit.pas -text
-packages/fcl-db/tests/dbtestframework.pas -text
+packages/fcl-db/tests/dbftoolsunit.pas svneol=native#text/plain
+packages/fcl-db/tests/dbtestframework.pas svneol=native#text/plain
 packages/fcl-db/tests/memdstoolsunit.pas svneol=native#text/plain
 packages/fcl-db/tests/memdstoolsunit.pas svneol=native#text/plain
 packages/fcl-db/tests/sdfdstoolsunit.pas svneol=native#text/plain
 packages/fcl-db/tests/sdfdstoolsunit.pas svneol=native#text/plain
-packages/fcl-db/tests/sqldbtoolsunit.pas -text
+packages/fcl-db/tests/sqldbtoolsunit.pas svneol=native#text/plain
 packages/fcl-db/tests/tcgensql.pas svneol=native#text/plain
 packages/fcl-db/tests/tcgensql.pas svneol=native#text/plain
 packages/fcl-db/tests/tcparser.pas svneol=native#text/plain
 packages/fcl-db/tests/tcparser.pas svneol=native#text/plain
 packages/fcl-db/tests/tcsqlscanner.pas svneol=native#text/plain
 packages/fcl-db/tests/tcsqlscanner.pas svneol=native#text/plain
 packages/fcl-db/tests/testbasics.pas svneol=native#text/plain
 packages/fcl-db/tests/testbasics.pas svneol=native#text/plain
 packages/fcl-db/tests/testbufdatasetstreams.pas svneol=native#text/plain
 packages/fcl-db/tests/testbufdatasetstreams.pas svneol=native#text/plain
 packages/fcl-db/tests/testdatasources.pas svneol=native#text/plain
 packages/fcl-db/tests/testdatasources.pas svneol=native#text/plain
-packages/fcl-db/tests/testdbbasics.pas -text
+packages/fcl-db/tests/testdbbasics.pas svneol=native#text/plain
 packages/fcl-db/tests/testdddiff.pp svneol=native#text/plain
 packages/fcl-db/tests/testdddiff.pp svneol=native#text/plain
 packages/fcl-db/tests/testfieldtypes.pas svneol=native#text/plain
 packages/fcl-db/tests/testfieldtypes.pas svneol=native#text/plain
 packages/fcl-db/tests/testsqlfiles.lpi svneol=native#text/plain
 packages/fcl-db/tests/testsqlfiles.lpi svneol=native#text/plain
@@ -1368,7 +1368,7 @@ packages/fcl-db/tests/testsqlfiles.lpr svneol=native#text/plain
 packages/fcl-db/tests/testsqlscanner.lpi svneol=native#text/plain
 packages/fcl-db/tests/testsqlscanner.lpi svneol=native#text/plain
 packages/fcl-db/tests/testsqlscanner.lpr svneol=native#text/plain
 packages/fcl-db/tests/testsqlscanner.lpr svneol=native#text/plain
 packages/fcl-db/tests/testsqlscript.pas svneol=native#text/plain
 packages/fcl-db/tests/testsqlscript.pas svneol=native#text/plain
-packages/fcl-db/tests/toolsunit.pas -text
+packages/fcl-db/tests/toolsunit.pas svneol=native#text/plain
 packages/fcl-extra/Makefile svneol=native#text/plain
 packages/fcl-extra/Makefile svneol=native#text/plain
 packages/fcl-extra/Makefile.fpc svneol=native#text/plain
 packages/fcl-extra/Makefile.fpc svneol=native#text/plain
 packages/fcl-extra/examples/Makefile svneol=native#text/plain
 packages/fcl-extra/examples/Makefile svneol=native#text/plain

+ 15 - 1
packages/fcl-db/src/base/bufdataset.pas

@@ -549,7 +549,7 @@ procedure RegisterDatapacketReader(ADatapacketReaderClass : TDatapacketReaderCla
 
 
 implementation
 implementation
 
 
-uses variants, dbconst;
+uses variants, dbconst, FmtBCD;
 
 
 Type TDatapacketReaderRegistration = record
 Type TDatapacketReaderRegistration = record
                                        ReaderClass : TDatapacketReaderClass;
                                        ReaderClass : TDatapacketReaderClass;
@@ -659,6 +659,18 @@ begin
     result := 0;
     result := 0;
 end;
 end;
 
 
+function DBCompareBCD(subValue, aValue: pointer; options: TLocateOptions): LargeInt;
+begin
+  // A simple subtraction doesn't work, since it could be that the result
+  // doesn't fit into a LargeInt
+  if PBCD(subValue)^ < PBCD(aValue)^ then
+    result := -1
+  else if PBCD(subValue)^  > PBCD(aValue)^ then
+    result := 1
+  else
+    result := 0;
+end;
+
 procedure unSetFieldIsNull(NullMask : pbyte;x : longint); //inline;
 procedure unSetFieldIsNull(NullMask : pbyte;x : longint); //inline;
 begin
 begin
   NullMask[x div 8] := (NullMask[x div 8]) and not (1 shl (x mod 8));
   NullMask[x div 8] := (NullMask[x div 8]) and not (1 shl (x mod 8));
@@ -1503,6 +1515,7 @@ begin
     ftDateTime, ftDate, ftTime : ACompareRec.Comparefunc :=
     ftDateTime, ftDate, ftTime : ACompareRec.Comparefunc :=
       @DBCompareDouble;
       @DBCompareDouble;
     ftLargeint : ACompareRec.Comparefunc := @DBCompareLargeInt;
     ftLargeint : ACompareRec.Comparefunc := @DBCompareLargeInt;
+    ftFmtBCD : ACompareRec.Comparefunc := @DBCompareBCD;
   else
   else
     DatabaseErrorFmt(SErrIndexBasedOnInvField, [AField.FieldName,Fieldtypenames[AField.DataType]]);
     DatabaseErrorFmt(SErrIndexBasedOnInvField, [AField.FieldName,Fieldtypenames[AField.DataType]]);
   end;
   end;
@@ -1638,6 +1651,7 @@ begin
       ftword     : result := sizeof(longint);
       ftword     : result := sizeof(longint);
     ftBoolean    : result := sizeof(wordbool);
     ftBoolean    : result := sizeof(wordbool);
     ftBCD        : result := sizeof(currency);
     ftBCD        : result := sizeof(currency);
+    ftFmtBCD     : result := sizeof(TBCD);
     ftFloat,
     ftFloat,
       ftCurrency : result := sizeof(double);
       ftCurrency : result := sizeof(double);
     ftLargeInt   : result := sizeof(largeint);
     ftLargeInt   : result := sizeof(largeint);

+ 1 - 2
packages/fcl-db/src/base/dataset.inc

@@ -901,8 +901,7 @@ begin
           if Required then Attributes := attributes + [faRequired];
           if Required then Attributes := attributes + [faRequired];
           if ReadOnly then Attributes := attributes + [faReadOnly];
           if ReadOnly then Attributes := attributes + [faReadOnly];
           if DataType = ftBCD then precision := (fields[i] as TBCDField).Precision
           if DataType = ftBCD then precision := (fields[i] as TBCDField).Precision
-          // this must change if TFMTBcdfield is implemented
-          else if DataType = ftFMTBcd then precision := (fields[i] as TBCDField).Precision;
+          else if DataType = ftFMTBcd then precision := (fields[i] as TFMTBCDField).Precision;
           end;
           end;
         end;
         end;
     finally
     finally

+ 44 - 2
packages/fcl-db/src/base/db.pas

@@ -794,6 +794,48 @@ type
     property Size default 4;
     property Size default 4;
   end;
   end;
 
 
+{ TFMTBCDField }
+
+  TFMTBCDField = class(TNumericField)
+  private
+    FMinValue,
+    FMaxValue   : TBCD;
+    FPrecision  : Longint;
+    FCurrency   : boolean;
+    function GetMaxValue: string;
+    function GetMinValue: string;
+    procedure SetMaxValue(const AValue: string);
+    procedure SetMinValue(const AValue: string);
+  protected
+    class procedure CheckTypeSize(AValue: Longint); override;
+    function GetAsBCD: TBCD; override;
+    function GetAsCurrency: Currency; override;
+    function GetAsFloat: Double; override;
+    function GetAsLongint: Longint; override;
+    function GetAsString: string; override;
+    function GetAsVariant: variant; override;
+    function GetDataSize: Integer; override;
+    function GetDefaultWidth: Longint; override;
+    procedure GetText(var TheText: string; ADisplayText: Boolean); override;
+    procedure SetAsBCD(const AValue: TBCD); override;
+    procedure SetAsFloat(AValue: Double); override;
+    procedure SetAsLongint(AValue: Longint); override;
+    procedure SetAsString(const AValue: string); override;
+    procedure SetAsCurrency(AValue: Currency); override;
+    procedure SetVarValue(const AValue: Variant); override;
+  public
+    constructor Create(AOwner: TComponent); override;
+    function CheckRange(AValue : TBCD) : Boolean;
+    property Value: TBCD read GetAsBCD write SetAsBCD;
+  published
+    property Precision: Longint read FPrecision write FPrecision default 15;
+    property Currency: Boolean read FCurrency write FCurrency;
+    property MaxValue: string read GetMaxValue write SetMaxValue;
+    property MinValue: string read GetMinValue write SetMinValue;
+    property Size default 4;
+  end;
+
+
 { TBlobField }
 { TBlobField }
   TBlobStreamMode = (bmRead, bmWrite, bmReadWrite);
   TBlobStreamMode = (bmRead, bmWrite, bmReadWrite);
   TBlobType = ftBlob..ftWideMemo;
   TBlobType = ftBlob..ftWideMemo;
@@ -1833,7 +1875,7 @@ const
     varOleStr, varOleStr, varOleStr, varOleStr, varOleStr, varOleStr, varError,
     varOleStr, varOleStr, varOleStr, varOleStr, varOleStr, varOleStr, varError,
     varOleStr, varOleStr, varError, varError, varError, varError, varError,
     varOleStr, varOleStr, varError, varError, varError, varError, varError,
     varOleStr, varOleStr, varVariant, varUnknown, varDispatch, varOleStr,
     varOleStr, varOleStr, varVariant, varUnknown, varDispatch, varOleStr,
-    varOleStr,varOleStr, varOleStr,varOleStr);
+    varOleStr, varDouble, varOleStr,varOleStr);
 
 
 
 
 Const
 Const
@@ -1942,7 +1984,7 @@ const
       { ftIDispatch} Nil,
       { ftIDispatch} Nil,
       { ftGuid} TGuidField,
       { ftGuid} TGuidField,
       { ftTimeStamp} Nil,
       { ftTimeStamp} Nil,
-      { ftFMTBcd} Nil,
+      { ftFMTBcd} TFMTBCDField,
       { ftFixedWideString} TWideStringField,
       { ftFixedWideString} TWideStringField,
       { ftWideMemo} TWideMemoField
       { ftWideMemo} TWideMemoField
     );
     );

+ 177 - 4
packages/fcl-db/src/base/fields.inc

@@ -109,10 +109,8 @@ begin
       TFloatField(Result).Precision:=FPrecision;
       TFloatField(Result).Precision:=FPrecision;
     if (Result is TBCDField) then
     if (Result is TBCDField) then
       TBCDField(Result).Precision:=FPrecision;
       TBCDField(Result).Precision:=FPrecision;
-    {Add when implemented:
     if (Result is TFmtBCDField) then
     if (Result is TFmtBCDField) then
       TFmtBCDField(Result).Precision:=FPrecision;
       TFmtBCDField(Result).Precision:=FPrecision;
-    }
   except
   except
     Result.Free;
     Result.Free;
     Raise;
     Raise;
@@ -821,7 +819,13 @@ procedure TField.SetData(Buffer: Pointer; NativeFormat : Boolean);
 
 
 begin
 begin
   If Not Assigned(FDataset) then
   If Not Assigned(FDataset) then
-    EDatabaseError.CreateFmt(SNoDataset,[FieldName]);
+    DatabaseErrorFmt(SNoDataset,[FieldName]);
+  if (FieldNo>0) and not (FDataSet.State in [dsSetKey, dsFilter]) then
+    begin
+    if ReadOnly then 
+      DatabaseErrorFmt(SReadOnlyField, [DisplayName], Self); 
+    Validate(Buffer);
+    end;
   FDataSet.SetFieldData(Self,Buffer, NativeFormat);
   FDataSet.SetFieldData(Self,Buffer, NativeFormat);
 end;
 end;
 
 
@@ -1072,7 +1076,7 @@ function TStringField.GetDataSize: Integer;
 
 
 begin
 begin
   if DataType=ftFixedChar then
   if DataType=ftFixedChar then
-    Result:=Size
+    Result:=Size+1
   else
   else
     Result:=Size+1;
     Result:=Size+1;
 end;
 end;
@@ -2395,6 +2399,175 @@ begin
 end;
 end;
 
 
 
 
+{ TFMTBCDField }
+
+class procedure TFMTBCDField.CheckTypeSize(AValue: Longint);
+begin
+  If AValue > MAXFMTBcdFractionSize then
+    DatabaseErrorfmt(SInvalidFieldSize,[AValue]);
+end;
+
+constructor TFMTBCDField.Create(AOwner: TComponent);
+begin
+  Inherited Create(AOwner);
+  FMaxValue := 0;
+  FMinValue := 0;
+  FValidChars := [DecimalSeparator, '+', '-', '0'..'9'];
+  SetDataType(ftFMTBCD);
+// Max.precision for NUMERIC,DECIMAL datatypes supported by some databases:
+//  Firebird-18; Oracle,SqlServer-38; MySQL-65; PostgreSQL-1000
+  Precision := 15; //default number of digits
+  Size:=4; //default number of digits after decimal place
+end;
+
+function TFMTBCDField.GetDataSize: Integer;
+begin
+  Result := sizeof(TBCD);
+end;
+
+function TFMTBCDField.GetDefaultWidth: Longint;
+begin
+  if Precision > 0 then Result := Precision+1
+  else Result := inherited GetDefaultWidth;
+end;
+
+function TFMTBCDField.GetAsBCD: TBCD;
+begin
+  if not GetData(@Result) then
+    Result := NullBCD;
+end;
+
+function TFMTBCDField.GetAsCurrency: Currency;
+var bcd: TBCD;
+begin
+  if GetData(@bcd) then
+    BCDToCurr(bcd, Result)
+  else
+    Result := 0;
+end;
+
+function TFMTBCDField.GetAsVariant: Variant;
+var bcd: TBCD;
+begin
+  If GetData(@bcd) then
+    Result := VarFMTBcdCreate(bcd)
+  else
+    Result := Null;
+end;
+
+function TFMTBCDField.GetAsFloat: Double;
+var bcd: TBCD;
+begin
+  If GetData(@bcd) then
+    Result := BCDToDouble(bcd)
+  else
+    Result := 0;
+end;
+
+function TFMTBCDField.GetAsLongint: Longint;
+begin
+  Result := round(GetAsFloat);
+end;
+
+function TFMTBCDField.GetAsString: string;
+var bcd: TBCD;
+begin
+  If GetData(@bcd) then
+    Result:=BCDToStr(bcd)
+  else
+    Result:='';
+end;
+
+procedure TFMTBCDField.GetText(var TheText: string; ADisplayText: Boolean);
+var
+  bcd: TBCD;
+  fmt: String;
+begin
+  if GetData(@bcd) then begin
+    if aDisplayText or (FEditFormat='') then
+      fmt := FDisplayFormat
+    else
+      fmt := FEditFormat;
+    if fmt<>'' then
+      TheText := BCDToStr(bcd)
+      //TheText := FormatBCD(fmt,bcd) //uncomment when formatBCD in fmtbcd.pp will be implemented
+    else if fCurrency then begin
+      if aDisplayText then
+        TheText := BcdToStrF(bcd, ffCurrency, FPrecision, 2)
+      else
+        TheText := BcdToStrF(bcd, ffFixed, FPrecision, 2);
+    end else
+      TheText := BcdToStrF(bcd, ffGeneral, FPrecision, FSize);
+  end else
+    TheText := '';
+end;
+
+function TFMTBCDField.GetMaxValue: string;
+begin
+  Result:=BCDToStr(FMaxValue);
+end;
+
+function TFMTBCDField.GetMinValue: string;
+begin
+  Result:=BCDToStr(FMinValue);
+end;
+
+procedure TFMTBCDField.SetMaxValue(const AValue: string);
+begin
+  FMaxValue:=StrToBCD(AValue);
+end;
+
+procedure TFMTBCDField.SetMinValue(const AValue: string);
+begin
+  FMinValue:=StrToBCD(AValue);
+end;
+
+Function TFMTBCDField.CheckRange(AValue: TBCD) : Boolean;
+begin
+  If (FMinValue<>0) or (FMaxValue<>0) then
+    Result:=(AValue>=FMinValue) and (AValue<=FMaxValue)
+  else
+    Result:=True;
+end;
+
+procedure TFMTBCDField.SetAsBCD(const AValue: TBCD);
+begin
+  if CheckRange(AValue) then
+    SetData(@AValue)
+  else
+    RangeError(AValue, BCDToDouble(FMinValue), BCDToDouble(FMaxValue));
+end;
+
+procedure TFMTBCDField.SetAsCurrency(AValue: Currency);
+var bcd: TBCD;
+begin
+  if CurrToBCD(AValue, bcd, 32, Size) then
+    SetAsBCD(bcd);
+end;
+
+procedure TFMTBCDField.SetVarValue(const AValue: Variant);
+begin
+  SetAsBCD(VarToBCD(AValue));
+end;
+
+procedure TFMTBCDField.SetAsFloat(AValue: Double);
+begin
+  SetAsBCD(DoubleToBCD(AValue));
+end;
+
+
+procedure TFMTBCDField.SetAsLongint(AValue: Longint);
+begin
+  SetAsBCD(IntegerToBCD(AValue));
+end;
+
+
+procedure TFMTBCDField.SetAsString(const AValue: string);
+begin
+  SetAsBCD(StrToBCD(AValue));
+end;
+
+
 { TBlobField }
 { TBlobField }
 
 
 Function TBlobField.GetBlobStream(Mode : TBlobStreamMode) : TStream;
 Function TBlobField.GetBlobStream(Mode : TBlobStreamMode) : TStream;

+ 2 - 0
packages/fcl-db/src/memds/memds.pp

@@ -300,6 +300,7 @@ begin
  dt1:= FieldDefs.Items[FieldNo-1].Datatype;
  dt1:= FieldDefs.Items[FieldNo-1].Datatype;
  case dt1 of
  case dt1 of
   ftString:   result:=FieldDefs.Items[FieldNo-1].Size+1;
   ftString:   result:=FieldDefs.Items[FieldNo-1].Size+1;
+  ftFixedChar:result:=FieldDefs.Items[FieldNo-1].Size+1;
   ftBoolean:  result:=SizeOf(Wordbool);
   ftBoolean:  result:=SizeOf(Wordbool);
   ftFloat:    result:=SizeOf(Double);
   ftFloat:    result:=SizeOf(Double);
   ftLargeInt: result:=SizeOf(int64);
   ftLargeInt: result:=SizeOf(int64);
@@ -964,6 +965,7 @@ begin
                 ftInteger  : F1.AsInteger:=F2.AsInteger;
                 ftInteger  : F1.AsInteger:=F2.AsInteger;
                 ftDate     : F1.AsDateTime:=F2.AsDateTime;
                 ftDate     : F1.AsDateTime:=F2.AsDateTime;
                 ftTime     : F1.AsDateTime:=F2.AsDateTime;
                 ftTime     : F1.AsDateTime:=F2.AsDateTime;
+                ftDateTime : F1.AsDateTime:=F2.AsDateTime;
               end;
               end;
               end;
               end;
             Try
             Try

+ 1 - 0
packages/fcl-db/src/sqldb/mysql/mysql50conn.pas

@@ -4,6 +4,7 @@
 
 
 unit mysql50conn;
 unit mysql50conn;
 
 
+{$DEFINE MYSQL50_up}
 {$DEFINE MYSQL50}
 {$DEFINE MYSQL50}
 
 
 {$i mysqlconn.inc}
 {$i mysqlconn.inc}

+ 2 - 0
packages/fcl-db/src/sqldb/mysql/mysql51conn.pas

@@ -4,6 +4,8 @@
 
 
 unit mysql51conn;
 unit mysql51conn;
 
 
+{$DEFINE MYSQL50_UP}
+{$DEFINE MYSQL51_UP}
 {$DEFINE MYSQL51}
 {$DEFINE MYSQL51}
 
 
 {$i mysqlconn.inc}
 {$i mysqlconn.inc}

+ 3 - 7
packages/fcl-db/src/sqldb/mysql/mysqlconn.inc

@@ -188,12 +188,8 @@ const
      'MYSQL_OPT_USE_REMOTE_CONNECTION','MYSQL_OPT_USE_EMBEDDED_CONNECTION',
      'MYSQL_OPT_USE_REMOTE_CONNECTION','MYSQL_OPT_USE_EMBEDDED_CONNECTION',
      'MYSQL_OPT_GUESS_CONNECTION','MYSQL_SET_CLIENT_IP',
      'MYSQL_OPT_GUESS_CONNECTION','MYSQL_SET_CLIENT_IP',
      'MYSQL_SECURE_AUTH'
      'MYSQL_SECURE_AUTH'
-{$IFDEF MYSQL50}
+{$IFDEF MYSQL50_UP}
      ,'MYSQL_REPORT_DATA_TRUNCATION', 'MYSQL_OPT_RECONNECT'
      ,'MYSQL_REPORT_DATA_TRUNCATION', 'MYSQL_OPT_RECONNECT'
-{$ELSE}     
-  {$IFDEF MYSQL51}
-     ,'MYSQL_REPORT_DATA_TRUNCATION', 'MYSQL_OPT_RECONNECT'
-  {$ENDIF}     
 {$ENDIF}
 {$ENDIF}
      );
      );
 
 
@@ -559,7 +555,7 @@ begin
       NewType := ftInteger;
       NewType := ftInteger;
       NewSize := 0;
       NewSize := 0;
       end;
       end;
-{$if defined(mysql51) or defined(mysql50)}
+{$ifdef mysql50_up}
     FIELD_TYPE_NEWDECIMAL,
     FIELD_TYPE_NEWDECIMAL,
 {$endif}
 {$endif}
     FIELD_TYPE_DECIMAL: if ADecimals < 5 then
     FIELD_TYPE_DECIMAL: if ADecimals < 5 then
@@ -867,7 +863,7 @@ begin
         VL := 0;
         VL := 0;
       Move(VL, Dest^, SizeOf(LargeInt));
       Move(VL, Dest^, SizeOf(LargeInt));
       end;
       end;
-{$if defined(mysql51) or defined(mysql50)}
+{$ifdef mysql50_up}
     FIELD_TYPE_NEWDECIMAL,
     FIELD_TYPE_NEWDECIMAL,
 {$endif}      
 {$endif}      
     FIELD_TYPE_DECIMAL, FIELD_TYPE_FLOAT, FIELD_TYPE_DOUBLE:
     FIELD_TYPE_DECIMAL, FIELD_TYPE_FLOAT, FIELD_TYPE_DOUBLE:

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

@@ -735,9 +735,9 @@ begin
   // TODO: finish this
   // TODO: finish this
   case FieldDef.DataType of
   case FieldDef.DataType of
     ftWideString,ftFixedWideChar: // mapped to TWideStringField
     ftWideString,ftFixedWideChar: // mapped to TWideStringField
-      Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_WCHAR, buffer, FieldDef.Size, @StrLenOrInd);
+      Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_WCHAR, buffer, FieldDef.Size+sizeof(WideChar), @StrLenOrInd); //buffer must contain space for the null-termination character
     ftGuid, ftFixedChar,ftString: // are mapped to a TStringField (including TGuidField)
     ftGuid, ftFixedChar,ftString: // are mapped to a TStringField (including TGuidField)
-      Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_CHAR, buffer, FieldDef.Size, @StrLenOrInd);
+      Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_CHAR, buffer, FieldDef.Size+1, @StrLenOrInd);
     ftSmallint:           // mapped to TSmallintField
     ftSmallint:           // mapped to TSmallintField
       Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_SSHORT, buffer, SizeOf(Smallint), @StrLenOrInd);
       Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_SSHORT, buffer, SizeOf(Smallint), @StrLenOrInd);
     ftInteger,ftWord,ftAutoInc:     // mapped to TLongintField
     ftInteger,ftWord,ftAutoInc:     // mapped to TLongintField
@@ -1023,12 +1023,12 @@ begin
     // convert type
     // convert type
     // NOTE: I made some guesses here after I found only limited information about TFieldType; please report any problems
     // NOTE: I made some guesses here after I found only limited information about TFieldType; please report any problems
     case DataType of
     case DataType of
-      SQL_CHAR:          begin FieldType:=ftFixedChar;  FieldSize:=ColumnSize+1; end;
-      SQL_VARCHAR:       begin FieldType:=ftString;     FieldSize:=ColumnSize+1; end;
+      SQL_CHAR:          begin FieldType:=ftFixedChar;  FieldSize:=ColumnSize; end;
+      SQL_VARCHAR:       begin FieldType:=ftString;     FieldSize:=ColumnSize; end;
       SQL_LONGVARCHAR:   begin FieldType:=ftMemo;       FieldSize:=BLOB_BUF_SIZE; end; // is a blob
       SQL_LONGVARCHAR:   begin FieldType:=ftMemo;       FieldSize:=BLOB_BUF_SIZE; end; // is a blob
 {$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}
 {$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}
-      SQL_WCHAR:         begin FieldType:=ftFixedWideChar; FieldSize:=(ColumnSize+1)*sizeof(Widechar); end;
-      SQL_WVARCHAR:      begin FieldType:=ftWideString; FieldSize:=(ColumnSize+1)*sizeof(Widechar); end;
+      SQL_WCHAR:         begin FieldType:=ftFixedWideChar; FieldSize:=ColumnSize*sizeof(Widechar); end;
+      SQL_WVARCHAR:      begin FieldType:=ftWideString; FieldSize:=ColumnSize*sizeof(Widechar); end;
       SQL_WLONGVARCHAR:  begin FieldType:=ftWideMemo;   FieldSize:=BLOB_BUF_SIZE; end; // is a blob
       SQL_WLONGVARCHAR:  begin FieldType:=ftWideMemo;   FieldSize:=BLOB_BUF_SIZE; end; // is a blob
 {$ENDIF}
 {$ENDIF}
       SQL_DECIMAL:       begin FieldType:=ftFloat;      FieldSize:=0; end;
       SQL_DECIMAL:       begin FieldType:=ftFloat;      FieldSize:=0; end;
@@ -1063,7 +1063,7 @@ begin
 {      SQL_INTERVAL_HOUR_TO_SECOND:  FieldType:=ftUnknown;}
 {      SQL_INTERVAL_HOUR_TO_SECOND:  FieldType:=ftUnknown;}
 {      SQL_INTERVAL_MINUTE_TO_SECOND:FieldType:=ftUnknown;}
 {      SQL_INTERVAL_MINUTE_TO_SECOND:FieldType:=ftUnknown;}
 {$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}
 {$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}
-      SQL_GUID:          begin FieldType:=ftGuid;       FieldSize:=ColumnSize+1; end;
+      SQL_GUID:          begin FieldType:=ftGuid;       FieldSize:=ColumnSize; end;
 {$ENDIF}
 {$ENDIF}
     else
     else
       begin FieldType:=ftUnknown; FieldSize:=ColumnSize; end
       begin FieldType:=ftUnknown; FieldSize:=ColumnSize; end

+ 10 - 6
packages/fcl-db/src/sqldb/postgres/pqconnection.pp

@@ -546,7 +546,7 @@ begin
       FPrepared := True;
       FPrepared := True;
       end
       end
     else
     else
-      statement := buf;
+      statement := AParams.ParseSQL(buf,false,sqEscapeSlash in ConnOptions, sqEscapeRepeat in ConnOptions,psPostgreSQL);
     end;
     end;
 end;
 end;
 
 
@@ -561,10 +561,11 @@ begin
       res := pqexec(tr.PGConn,pchar('deallocate prepst'+nr));
       res := pqexec(tr.PGConn,pchar('deallocate prepst'+nr));
       if (PQresultStatus(res) <> PGRES_COMMAND_OK) then
       if (PQresultStatus(res) <> PGRES_COMMAND_OK) then
         begin
         begin
+          pqclear(res);
+          DatabaseError(SErrPrepareFailed + ' (PostgreSQL: ' + PQerrorMessage(tr.PGConn) + ')',self)
+        end
+      else
         pqclear(res);
         pqclear(res);
-        DatabaseError(SErrPrepareFailed + ' (PostgreSQL: ' + PQerrorMessage(tr.PGConn) + ')',self)
-        end;
-      pqclear(res);
       end;
       end;
     FPrepared := False;
     FPrepared := False;
     end;
     end;
@@ -641,9 +642,12 @@ begin
         s := Statement;
         s := Statement;
       res := pqexec(tr.PGConn,pchar(s));
       res := pqexec(tr.PGConn,pchar(s));
       if (PQresultStatus(res) in [PGRES_COMMAND_OK,PGRES_TUPLES_OK]) then
       if (PQresultStatus(res) in [PGRES_COMMAND_OK,PGRES_TUPLES_OK]) then
-        pqclear(res);
+        begin
+          pqclear(res); 
+          res:=nil;
+        end;
       end;
       end;
-    if not (PQresultStatus(res) in [PGRES_COMMAND_OK,PGRES_TUPLES_OK]) then
+    if assigned(res) and not (PQresultStatus(res) in [PGRES_COMMAND_OK,PGRES_TUPLES_OK]) then
       begin
       begin
       s := PQerrorMessage(tr.PGConn);
       s := PQerrorMessage(tr.PGConn);
       pqclear(res);
       pqclear(res);

+ 37 - 4
packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp

@@ -99,7 +99,7 @@ Var
 implementation
 implementation
 
 
 uses
 uses
-  dbconst, sysutils, dateutils;
+  dbconst, sysutils, dateutils,FmtBCD;
  
  
 type
 type
 
 
@@ -364,9 +364,16 @@ begin
       ft1:=FieldMap[fi].t;
       ft1:=FieldMap[fi].t;
       break;
       break;
       end;
       end;
-    // Empty field types are allowed and used in calculated columns (aggregates)
-    // and by pragma-statements
-    if FD='' then ft1 := ftString;
+    // In case of an empty fieldtype (FD='', which is allowed and used in calculated
+    // columns (aggregates) and by pragma-statements) or an unknown fieldtype,
+    // use the field's affinity:
+    if ft1=ftUnknown then
+      case TStorageType(sqlite3_column_type(st,i)) of
+        stInteger: ft1:=ftLargeInt;
+        stFloat:   ft1:=ftFloat;
+        stBlob:    ft1:=ftBlob;
+        else       ft1:=ftString;
+      end;
     // handle some specials.
     // handle some specials.
     size1:=0;
     size1:=0;
     case ft1 of
     case ft1 of
@@ -388,6 +395,8 @@ begin
                   System.Delete(FD,1,fi);
                   System.Delete(FD,1,fi);
                   fi:=pos(')',FD);
                   fi:=pos(')',FD);
                   size1:=StrToIntDef(trim(copy(FD,1,fi-1)),255);
                   size1:=StrToIntDef(trim(copy(FD,1,fi-1)),255);
+                  if size1>4 then
+                    ft1 := ftFMTBcd;
                   end
                   end
                 else size1 := 4;
                 else size1 := 4;
                 end;
                 end;
@@ -482,6 +491,9 @@ var
  i64: int64;
  i64: int64;
  int1,int2: integer;
  int1,int2: integer;
  str1: string;
  str1: string;
+ bcd: tBCD;
+ StoreDecimalPoint: tDecimalPoint;
+ bcdstr: FmtBCDStringtype;
  ar1,ar2: TStringArray;
  ar1,ar2: TStringArray;
  st    : psqlite3_stmt;
  st    : psqlite3_stmt;
 
 
@@ -519,6 +531,27 @@ begin
               if int1 > 0 then 
               if int1 > 0 then 
                  move(sqlite3_column_text(st,fnum)^,buffer^,int1);
                  move(sqlite3_column_text(st,fnum)^,buffer^,int1);
               end;
               end;
+    ftFmtBCD: begin
+              int1:= sqlite3_column_bytes(st,fnum);
+              if int1>255 then
+                int1:=255;
+              if int1 > 0 then
+                begin
+                SetLength(bcdstr,int1);
+                move(sqlite3_column_text(st,fnum)^,bcdstr[1],int1);
+                StoreDecimalPoint:=FmtBCD.DecimalPoint;
+                // sqlite always uses the point as decimal-point
+                FmtBCD.DecimalPoint:=DecimalPoint_is_Point;
+                if not TryStrToBCD(bcdstr,bcd) then
+                  // sqlite does the same, if the value can't be interpreted as a
+                  // number in sqlite3_column_int, return 0
+                  bcd := 0;
+                FmtBCD.DecimalPoint:=StoreDecimalPoint;
+                end
+              else
+                bcd := 0;
+              pBCD(buffer)^:= bcd;
+              end;
     ftMemo,
     ftMemo,
     ftBlob: CreateBlob:=True;
     ftBlob: CreateBlob:=True;
   else { Case }
   else { Case }

+ 7 - 9
packages/fcl-db/tests/sqldbtoolsunit.pas

@@ -7,13 +7,13 @@ interface
 uses
 uses
   Classes, SysUtils, toolsunit,
   Classes, SysUtils, toolsunit,
   db,
   db,
-  sqldb, ibconnection, mysql40conn, mysql41conn, mysql50conn, pqconnection,odbcconn,oracleconnection,sqlite3conn;
+  sqldb, ibconnection, mysql40conn, mysql41conn, mysql50conn, mysql51conn, pqconnection,odbcconn,oracleconnection,sqlite3conn;
 
 
-type TSQLDBTypes = (mysql40,mysql41,mysql50,postgresql,interbase,odbc,oracle,sqlite3);
+type TSQLDBTypes = (mysql40,mysql41,mysql50,mysql51,postgresql,interbase,odbc,oracle,sqlite3);
 
 
 const MySQLdbTypes = [mysql40,mysql41,mysql50,mysql51];
 const MySQLdbTypes = [mysql40,mysql41,mysql50,mysql51];
       DBTypesNames : Array [TSQLDBTypes] of String[19] =
       DBTypesNames : Array [TSQLDBTypes] of String[19] =
-             ('MYSQL40','MYSQL41','MYSQL50','POSTGRESQL','INTERBASE','ODBC','ORACLE','SQLITE3');
+             ('MYSQL40','MYSQL41','MYSQL50','MYSQL51','POSTGRESQL','INTERBASE','ODBC','ORACLE','SQLITE3');
              
              
       FieldtypeDefinitionsConst : Array [TFieldType] of String[15] =
       FieldtypeDefinitionsConst : Array [TFieldType] of String[15] =
         (
         (
@@ -27,7 +27,7 @@ const MySQLdbTypes = [mysql40,mysql41,mysql50,mysql51];
           '',
           '',
           'DECIMAL(18,4)',
           'DECIMAL(18,4)',
           'DATE',
           'DATE',
-          'TIMESTAMP',
+          'TIME',
           'TIMESTAMP',
           'TIMESTAMP',
           '',
           '',
           '',
           '',
@@ -42,7 +42,7 @@ const MySQLdbTypes = [mysql40,mysql41,mysql50,mysql51];
           '',
           '',
           'CHAR(10)',
           'CHAR(10)',
           '',
           '',
-          '',
+          'BIGINT',
           '',
           '',
           '',
           '',
           '',
           '',
@@ -54,7 +54,7 @@ const MySQLdbTypes = [mysql40,mysql41,mysql50,mysql51];
           '',
           '',
           '',
           '',
           'TIMESTAMP',
           'TIMESTAMP',
-          '',
+          'NUMERIC(18,6)',
           '',
           '',
           ''
           ''
         );
         );
@@ -115,8 +115,7 @@ begin
       testStringValues[t] := TrimRight(testStringValues[t]);
       testStringValues[t] := TrimRight(testStringValues[t]);
     end;
     end;
   if SQLDbType = MYSQL50 then Fconnection := tMySQL50Connection.Create(nil);
   if SQLDbType = MYSQL50 then Fconnection := tMySQL50Connection.Create(nil);
-  if SQLDbType in MySQLdbTypes then
-    FieldtypeDefinitions[ftLargeint] := 'BIGINT';
+  if SQLDbType = MYSQL51 then Fconnection := tMySQL51Connection.Create(nil);
   if SQLDbType = sqlite3 then
   if SQLDbType = sqlite3 then
     begin
     begin
     Fconnection := TSQLite3Connection.Create(nil);
     Fconnection := TSQLite3Connection.Create(nil);
@@ -134,7 +133,6 @@ begin
   if SQLDbType = INTERBASE then
   if SQLDbType = INTERBASE then
     begin
     begin
     Fconnection := tIBConnection.Create(nil);
     Fconnection := tIBConnection.Create(nil);
-    FieldtypeDefinitions[ftLargeint] := 'BIGINT';
     end;
     end;
   if SQLDbType = ODBC then Fconnection := tODBCConnection.Create(nil);
   if SQLDbType = ODBC then Fconnection := tODBCConnection.Create(nil);
   if SQLDbType = ORACLE then Fconnection := TOracleConnection.Create(nil);
   if SQLDbType = ORACLE then Fconnection := TOracleConnection.Create(nil);

+ 46 - 1
packages/fcl-db/tests/testdbbasics.pas

@@ -54,8 +54,10 @@ type
     procedure TestSupportFloatFields;
     procedure TestSupportFloatFields;
     procedure TestSupportLargeIntFields;
     procedure TestSupportLargeIntFields;
     procedure TestSupportDateFields;
     procedure TestSupportDateFields;
+    procedure TestSupportTimeFields;
     procedure TestSupportCurrencyFields;
     procedure TestSupportCurrencyFields;
     procedure TestSupportBCDFields;
     procedure TestSupportBCDFields;
+    procedure TestSupportfmtBCDFields;
     procedure TestSupportFixedStringFields;
     procedure TestSupportFixedStringFields;
 
 
     procedure TestAppendOnEmptyDataset;
     procedure TestAppendOnEmptyDataset;
@@ -145,7 +147,7 @@ type
 
 
 implementation
 implementation
 
 
-uses bufdataset, variants, strutils, sqldb;
+uses bufdataset, variants, strutils, sqldb, FmtBCD;
 
 
 type THackDataLink=class(TdataLink);
 type THackDataLink=class(TdataLink);
 
 
@@ -1916,6 +1918,31 @@ begin
   ds.close;
   ds.close;
 end;
 end;
 
 
+procedure TTestDBBasics.TestSupportTimeFields;
+var i          : byte;
+    ds         : TDataset;
+    Fld        : TField;
+    s          : string;
+    millisecond: word;
+    second     : word;
+    minute     : word;
+    hour       : word;
+begin
+  TestfieldDefinition(ftTime,8,ds,Fld);
+
+  for i := 0 to testValuesCount-1 do
+    begin
+    // Format the datetime in the format hh:nn:ss:zzz, where the hours can be bigger then 23.
+    DecodeTime(fld.AsDateTime,hour,minute,second,millisecond);
+    hour := hour + (trunc(Fld.AsDateTime) * 24);
+    s := Format('%.2d',[hour]) + ':' + format('%.2d',[minute]) + ':' + format('%.2d',[second]) + ':' + format('%.3d',[millisecond]);
+
+    AssertEquals(testTimeValues[i],s);
+    ds.Next;
+    end;
+  ds.close;
+end;
+
 procedure TTestDBBasics.TestSupportCurrencyFields;
 procedure TTestDBBasics.TestSupportCurrencyFields;
 
 
 var i          : byte;
 var i          : byte;
@@ -1953,6 +1980,24 @@ begin
   ds.close;
   ds.close;
 end;
 end;
 
 
+procedure TTestDBBasics.TestSupportfmtBCDFields;
+var i          : byte;
+    ds         : TDataset;
+    Fld        : TField;
+
+begin
+  TestfieldDefinition(ftFMTBcd,sizeof(TBCD),ds,Fld);
+
+  for i := 0 to testValuesCount-1 do
+    begin
+    AssertEquals(testFmtBCDValues[i],Fld.AsString);
+    AssertEquals(testFmtBCDValues[i],Fld.AsBCD);
+    AssertEquals(StrToFloat(testFmtBCDValues[i]),Fld.AsFloat);
+    ds.Next;
+    end;
+  ds.close;
+end;
+
 procedure TTestDBBasics.TestSupportFixedStringFields;
 procedure TTestDBBasics.TestSupportFixedStringFields;
 var i          : byte;
 var i          : byte;
     ds         : TDataset;
     ds         : TDataset;

+ 56 - 8
packages/fcl-db/tests/testfieldtypes.pas

@@ -1,6 +1,7 @@
 unit TestFieldTypes;
 unit TestFieldTypes;
 
 
 {$mode objfpc}{$H+}
 {$mode objfpc}{$H+}
+{$modeswitch nestedprocvars}
 
 
 interface
 interface
 
 
@@ -9,10 +10,10 @@ uses
   db;
   db;
 
 
 type
 type
-
-
   TParamProc = procedure(AParam:TParam; i : integer);
   TParamProc = procedure(AParam:TParam; i : integer);
   TFieldProc = procedure(AField:TField; i : integer);
   TFieldProc = procedure(AField:TField; i : integer);
+  TGetSQLTextProc = function(const i: integer) : string; { is nested;}
+  TCheckFieldValueProc = procedure(AField:TField; i : integer) is nested;
 
 
   { TTestFieldTypes }
   { TTestFieldTypes }
 
 
@@ -20,6 +21,9 @@ type
   private
   private
     procedure CreateTableWithFieldType(ADatatype : TFieldType; ASQLTypeDecl : string);
     procedure CreateTableWithFieldType(ADatatype : TFieldType; ASQLTypeDecl : string);
     procedure TestFieldDeclaration(ADatatype: TFieldType; ADataSize: integer);
     procedure TestFieldDeclaration(ADatatype: TFieldType; ADataSize: integer);
+    procedure TestSQLFieldType(ADatatype: TFieldType; ASQLTypeDecl: string;
+      ADataSize: integer; AGetSQLTextProc: TGetSQLTextProc;
+      ACheckFieldValueProc: TCheckFieldValueProc);
     procedure TestXXParamQuery(ADatatype : TFieldType; ASQLTypeDecl : string; testValuescount : integer; Cross : boolean = false);
     procedure TestXXParamQuery(ADatatype : TFieldType; ASQLTypeDecl : string; testValuescount : integer; Cross : boolean = false);
     procedure TestSetBlobAsParam(asWhat : integer);
     procedure TestSetBlobAsParam(asWhat : integer);
   protected
   protected
@@ -99,6 +103,7 @@ type
 
 
     // Test SQL-field type recognition
     // Test SQL-field type recognition
     procedure TestSQLClob;
     procedure TestSQLClob;
+    procedure TestSQLLargeint;
   end;
   end;
 
 
 implementation
 implementation
@@ -1386,7 +1391,10 @@ begin
     begin
     begin
     with query do
     with query do
       begin
       begin
-      SQL.Text:='select NAME from FPDEV where NAME=''TestName21'' limit 1';
+      if (sqlDBtype=interbase) then
+        SQL.Text:='select first 1 NAME from FPDEV where NAME=''TestName21'''
+      else
+        SQL.Text:='select NAME from FPDEV where NAME=''TestName21'' limit 1';
       Open;
       Open;
       close;
       close;
       ServerFilter:='ID=21';
       ServerFilter:='ID=21';
@@ -1583,28 +1591,68 @@ begin
     end;
     end;
 end;
 end;
 
 
-procedure TTestFieldTypes.TestSQLClob;
+procedure TTestFieldTypes.TestSQLFieldType(ADatatype : TFieldType; ASQLTypeDecl : string; ADataSize: integer; AGetSQLTextProc: TGetSQLTextProc; ACheckFieldValueProc: TCheckFieldValueProc);
 var
 var
   i          : byte;
   i          : byte;
+  s: string;
 begin
 begin
-  CreateTableWithFieldType(ftMemo,'CLOB');
-  TestFieldDeclaration(ftMemo,0);
+  CreateTableWithFieldType(ADatatype,ASQLTypeDecl);
+  TestFieldDeclaration(ADatatype,ADataSize);
 
 
   for i := 0 to testValuesCount-1 do
   for i := 0 to testValuesCount-1 do
-    TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (' + QuotedStr(testStringValues[i]) + ')');
+    begin
+    s := AGetSQLTextProc(i);
+    TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (' + s + ')');
+    end;
 
 
   with TSQLDBConnector(DBConnector).Query do
   with TSQLDBConnector(DBConnector).Query do
     begin
     begin
     Open;
     Open;
     for i := 0 to testValuesCount-1 do
     for i := 0 to testValuesCount-1 do
       begin
       begin
-      AssertEquals(testStringValues[i],fields[0].AsString);
+      ACheckFieldValueProc(fields[0],i);
       Next;
       Next;
       end;
       end;
     close;
     close;
     end;
     end;
 end;
 end;
 
 
+// Placed here, as long as bug 18702 is not solved
+function TestSQLClob_GetSQLText(const a: integer) : string;
+begin
+  result := QuotedStr(testStringValues[a]);
+end;
+
+procedure TTestFieldTypes.TestSQLClob;
+  procedure CheckFieldValue(AField:TField; a : integer);
+  begin
+    AssertEquals(testStringValues[a],AField.AsString);
+  end;
+begin
+  if SQLDbType=interbase then
+      Ignore('This test does not apply to Interbase/Firebird, since it does not support CLOB fields');
+  TestSQLFieldType(ftMemo, 'CLOB', 0, @TestSQLClob_GetSQLText, @CheckFieldValue);
+end;
+
+// Placed here, as long as bug 18702 is not solved
+function TestSQLLargeInt_GetSQLText(const a: integer) : string;
+begin
+  result := IntToStr(testLargeIntValues[a]);
+end;
+
+procedure TTestFieldTypes.TestSQLLargeint;
+  procedure CheckFieldValue(AField:TField; a : integer);
+  begin
+    AssertEquals(testLargeIntValues[a],AField.AsLargeInt);
+  end;
+begin
+  if sqlDBType=interbase then
+    TestSQLFieldType(ftLargeint, 'BIGINT', 8, @TestSQLLargeint_GetSQLText, @CheckFieldValue)
+  else
+    TestSQLFieldType(ftLargeint, 'LARGEINT', 8, @TestSQLLargeint_GetSQLText, @CheckFieldValue);
+end;
+
+
 procedure TTestFieldTypes.TestUpdateIndexDefs;
 procedure TTestFieldTypes.TestUpdateIndexDefs;
 var ds : TSQLQuery;
 var ds : TSQLQuery;
 begin
 begin

+ 33 - 1
packages/fcl-db/tests/toolsunit.pas

@@ -7,7 +7,7 @@ unit ToolsUnit;
 interface
 interface
 
 
 uses
 uses
-  Classes, SysUtils, DB, testdecorator;
+  Classes, SysUtils, DB, testdecorator, FmtBCD;
   
   
 Const MaxDataSet = 35;
 Const MaxDataSet = 35;
   
   
@@ -95,6 +95,7 @@ const
   testValuesCount = 25;
   testValuesCount = 25;
   testFloatValues : Array[0..testValuesCount-1] of double = (-maxSmallint-1,-maxSmallint,-256,-255,-128,-127,-1,0,1,127,128,255,256,maxSmallint,maxSmallint+1,0.123456,-0.123456,4.35,12.434E7,9.876e-5,123.45678,2.4,3.2,0.4,23);
   testFloatValues : Array[0..testValuesCount-1] of double = (-maxSmallint-1,-maxSmallint,-256,-255,-128,-127,-1,0,1,127,128,255,256,maxSmallint,maxSmallint+1,0.123456,-0.123456,4.35,12.434E7,9.876e-5,123.45678,2.4,3.2,0.4,23);
   testCurrencyValues : Array[0..testValuesCount-1] of currency = (-100,-65.5,-54.34,-43.34,-2.50,-0.2,45.40,0.3,45.4,127,128,255,256,45,0.3,45.4,127,128,255,256,45,1234.56,43.23,43.43,99.88);
   testCurrencyValues : Array[0..testValuesCount-1] of currency = (-100,-65.5,-54.34,-43.34,-2.50,-0.2,45.40,0.3,45.4,127,128,255,256,45,0.3,45.4,127,128,255,256,45,1234.56,43.23,43.43,99.88);
+  testFmtBCDValues : Array[0..testValuesCount-1] of string = ('-100','-65.5','-54.3333','-43.3334','-2.5','-0.234567','45.4','0.3','45.414585','127','128','255','256','45','0.3','45.4','127','128','255','256','45','1234.56789','43.23','43.500001','99.88');
   testIntValues : Array[0..testValuesCount-1] of integer = (-maxInt,-maxInt+1,-maxSmallint-1,-maxSmallint,-256,-255,-128,-127,-1,0,1,127,128,255,256,maxSmallint,maxSmallint+1,MaxInt-1,MaxInt,100,130,150,-150,-132,234);
   testIntValues : Array[0..testValuesCount-1] of integer = (-maxInt,-maxInt+1,-maxSmallint-1,-maxSmallint,-256,-255,-128,-127,-1,0,1,127,128,255,256,maxSmallint,maxSmallint+1,MaxInt-1,MaxInt,100,130,150,-150,-132,234);
   testSmallIntValues : Array[0..testValuesCount-1] of smallint = (-maxSmallint,-maxSmallint+1,-256,-255,-128,-127,-1,0,1,127,128,255,256,maxSmallint,maxSmallint-1,100,110,120,130,150,-150,-132,234,231,42);
   testSmallIntValues : Array[0..testValuesCount-1] of smallint = (-maxSmallint,-maxSmallint+1,-256,-255,-128,-127,-1,0,1,127,128,255,256,maxSmallint,maxSmallint-1,100,110,120,130,150,-150,-132,234,231,42);
   testLargeIntValues : Array[0..testValuesCount-1] of LargeInt = ( -$7fffffffffffffff,-$7ffffffffffffffe,-maxInt-1,-maxInt+1,-maxSmallint,-maxSmallint+1,-256,-255,-128,-127,-1,0,1,127,128,255,256,maxSmallint,maxSmallint-1,maxSmallint+1,MaxInt-1,MaxInt,$7fffffffffffffff-1,$7fffffffffffffff,235253244);
   testLargeIntValues : Array[0..testValuesCount-1] of LargeInt = ( -$7fffffffffffffff,-$7ffffffffffffffe,-maxInt-1,-maxInt+1,-maxSmallint,-maxSmallint+1,-256,-255,-128,-127,-1,0,1,127,128,255,256,maxSmallint,maxSmallint-1,maxSmallint+1,MaxInt-1,MaxInt,$7fffffffffffffff-1,$7fffffffffffffff,235253244);
@@ -156,6 +157,35 @@ const
     '1900-01-01'
     '1900-01-01'
   );
   );
 
 
+  testTimeValues : Array[0..testValuesCount-1] of string = (
+    '10:45:12:000',
+    '00:00:00:000',
+    '24:00:00:000',
+    '33:25:15:000',
+    '04:59:16:000',
+    '05:45:59:000',
+    '16:35:42:000',
+    '14:45:52:000',
+    '12:45:12:000',
+    '18:45:22:000',
+    '19:45:12:000',
+    '14:45:14:000',
+    '16:45:12:000',
+    '11:45:12:000',
+    '15:35:12:000',
+    '16:45:12:000',
+    '13:55:12:000',
+    '13:46:12:000',
+    '15:35:12:000',
+    '17:25:12:000',
+    '19:45:12:000',
+    '10:54:12:000',
+    '12:25:12:000',
+    '20:15:12:000',
+    '12:25:12:000'
+  );
+
+
 var dbtype,
 var dbtype,
     dbconnectorname,
     dbconnectorname,
     dbconnectorparams,
     dbconnectorparams,
@@ -255,6 +285,8 @@ begin
   if DBConnectorRefCount>0 then exit;
   if DBConnectorRefCount>0 then exit;
   testValues[ftString] := testStringValues;
   testValues[ftString] := testStringValues;
   testValues[ftFixedChar] := testStringValues;
   testValues[ftFixedChar] := testStringValues;
+  testValues[ftTime] := testTimeValues;
+  testValues[ftFMTBcd] := testFmtBCDValues;
   for i := 0 to testValuesCount-1 do
   for i := 0 to testValuesCount-1 do
     begin
     begin
     testValues[ftFloat,i] := FloatToStr(testFloatValues[i]);
     testValues[ftFloat,i] := FloatToStr(testFloatValues[i]);

+ 8 - 1
packages/odbc/src/odbcsql.inc

@@ -20,7 +20,11 @@
 {$endif fpc}
 {$endif fpc}
 
 
 {$ifndef DYNLOADINGODBC}
 {$ifndef DYNLOADINGODBC}
+{$IFDEF WINDOWS}
+  {$linklib odbc32}
+{$ELSE}
   {$linklib odbc}
   {$linklib odbc}
+{$endif} 
 {$endif}
 {$endif}
 
 
 interface
 interface
@@ -1711,7 +1715,10 @@ end;
 Function TimeStructToDateTime (B : PSQL_TIME_STRUCT) : TDateTime;
 Function TimeStructToDateTime (B : PSQL_TIME_STRUCT) : TDateTime;
 begin
 begin
   With B^ do
   With B^ do
-    Result:=EncodeTime(Hour,Minute,Second,0);
+    begin
+      // TryEncodeTime can not be used, because it doesn't supports times with more then 24 hours.
+      Result:=TDateTime(cardinal(Hour)*3600000+cardinal(Minute)*60000+cardinal(Second)*1000)/MSecsPerDay;
+    end;
 end;
 end;