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/README.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/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/tcparser.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/testbufdatasetstreams.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/testfieldtypes.pas 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.lpr 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.fpc 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
 
-uses variants, dbconst;
+uses variants, dbconst, FmtBCD;
 
 Type TDatapacketReaderRegistration = record
                                        ReaderClass : TDatapacketReaderClass;
@@ -659,6 +659,18 @@ begin
     result := 0;
 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;
 begin
   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 :=
       @DBCompareDouble;
     ftLargeint : ACompareRec.Comparefunc := @DBCompareLargeInt;
+    ftFmtBCD : ACompareRec.Comparefunc := @DBCompareBCD;
   else
     DatabaseErrorFmt(SErrIndexBasedOnInvField, [AField.FieldName,Fieldtypenames[AField.DataType]]);
   end;
@@ -1638,6 +1651,7 @@ begin
       ftword     : result := sizeof(longint);
     ftBoolean    : result := sizeof(wordbool);
     ftBCD        : result := sizeof(currency);
+    ftFmtBCD     : result := sizeof(TBCD);
     ftFloat,
       ftCurrency : result := sizeof(double);
     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 ReadOnly then Attributes := attributes + [faReadOnly];
           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;
     finally

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

@@ -794,6 +794,48 @@ type
     property Size default 4;
   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 }
   TBlobStreamMode = (bmRead, bmWrite, bmReadWrite);
   TBlobType = ftBlob..ftWideMemo;
@@ -1833,7 +1875,7 @@ const
     varOleStr, varOleStr, varOleStr, varOleStr, varOleStr, varOleStr, varError,
     varOleStr, varOleStr, varError, varError, varError, varError, varError,
     varOleStr, varOleStr, varVariant, varUnknown, varDispatch, varOleStr,
-    varOleStr,varOleStr, varOleStr,varOleStr);
+    varOleStr, varDouble, varOleStr,varOleStr);
 
 
 Const
@@ -1942,7 +1984,7 @@ const
       { ftIDispatch} Nil,
       { ftGuid} TGuidField,
       { ftTimeStamp} Nil,
-      { ftFMTBcd} Nil,
+      { ftFMTBcd} TFMTBCDField,
       { ftFixedWideString} TWideStringField,
       { ftWideMemo} TWideMemoField
     );

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

@@ -109,10 +109,8 @@ begin
       TFloatField(Result).Precision:=FPrecision;
     if (Result is TBCDField) then
       TBCDField(Result).Precision:=FPrecision;
-    {Add when implemented:
     if (Result is TFmtBCDField) then
       TFmtBCDField(Result).Precision:=FPrecision;
-    }
   except
     Result.Free;
     Raise;
@@ -821,7 +819,13 @@ procedure TField.SetData(Buffer: Pointer; NativeFormat : Boolean);
 
 begin
   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);
 end;
 
@@ -1072,7 +1076,7 @@ function TStringField.GetDataSize: Integer;
 
 begin
   if DataType=ftFixedChar then
-    Result:=Size
+    Result:=Size+1
   else
     Result:=Size+1;
 end;
@@ -2395,6 +2399,175 @@ begin
 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 }
 
 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;
  case dt1 of
   ftString:   result:=FieldDefs.Items[FieldNo-1].Size+1;
+  ftFixedChar:result:=FieldDefs.Items[FieldNo-1].Size+1;
   ftBoolean:  result:=SizeOf(Wordbool);
   ftFloat:    result:=SizeOf(Double);
   ftLargeInt: result:=SizeOf(int64);
@@ -964,6 +965,7 @@ begin
                 ftInteger  : F1.AsInteger:=F2.AsInteger;
                 ftDate     : F1.AsDateTime:=F2.AsDateTime;
                 ftTime     : F1.AsDateTime:=F2.AsDateTime;
+                ftDateTime : F1.AsDateTime:=F2.AsDateTime;
               end;
               end;
             Try

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

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

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

@@ -4,6 +4,8 @@
 
 unit mysql51conn;
 
+{$DEFINE MYSQL50_UP}
+{$DEFINE MYSQL51_UP}
 {$DEFINE MYSQL51}
 
 {$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_GUESS_CONNECTION','MYSQL_SET_CLIENT_IP',
      'MYSQL_SECURE_AUTH'
-{$IFDEF MYSQL50}
+{$IFDEF MYSQL50_UP}
      ,'MYSQL_REPORT_DATA_TRUNCATION', 'MYSQL_OPT_RECONNECT'
-{$ELSE}     
-  {$IFDEF MYSQL51}
-     ,'MYSQL_REPORT_DATA_TRUNCATION', 'MYSQL_OPT_RECONNECT'
-  {$ENDIF}     
 {$ENDIF}
      );
 
@@ -559,7 +555,7 @@ begin
       NewType := ftInteger;
       NewSize := 0;
       end;
-{$if defined(mysql51) or defined(mysql50)}
+{$ifdef mysql50_up}
     FIELD_TYPE_NEWDECIMAL,
 {$endif}
     FIELD_TYPE_DECIMAL: if ADecimals < 5 then
@@ -867,7 +863,7 @@ begin
         VL := 0;
       Move(VL, Dest^, SizeOf(LargeInt));
       end;
-{$if defined(mysql51) or defined(mysql50)}
+{$ifdef mysql50_up}
     FIELD_TYPE_NEWDECIMAL,
 {$endif}      
     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
   case FieldDef.DataType of
     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)
-      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
       Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_SSHORT, buffer, SizeOf(Smallint), @StrLenOrInd);
     ftInteger,ftWord,ftAutoInc:     // mapped to TLongintField
@@ -1023,12 +1023,12 @@ begin
     // convert type
     // NOTE: I made some guesses here after I found only limited information about TFieldType; please report any problems
     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
 {$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
 {$ENDIF}
       SQL_DECIMAL:       begin FieldType:=ftFloat;      FieldSize:=0; end;
@@ -1063,7 +1063,7 @@ begin
 {      SQL_INTERVAL_HOUR_TO_SECOND:  FieldType:=ftUnknown;}
 {      SQL_INTERVAL_MINUTE_TO_SECOND:FieldType:=ftUnknown;}
 {$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}
     else
       begin FieldType:=ftUnknown; FieldSize:=ColumnSize; end

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

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

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

@@ -99,7 +99,7 @@ Var
 implementation
 
 uses
-  dbconst, sysutils, dateutils;
+  dbconst, sysutils, dateutils,FmtBCD;
  
 type
 
@@ -364,9 +364,16 @@ begin
       ft1:=FieldMap[fi].t;
       break;
       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.
     size1:=0;
     case ft1 of
@@ -388,6 +395,8 @@ begin
                   System.Delete(FD,1,fi);
                   fi:=pos(')',FD);
                   size1:=StrToIntDef(trim(copy(FD,1,fi-1)),255);
+                  if size1>4 then
+                    ft1 := ftFMTBcd;
                   end
                 else size1 := 4;
                 end;
@@ -482,6 +491,9 @@ var
  i64: int64;
  int1,int2: integer;
  str1: string;
+ bcd: tBCD;
+ StoreDecimalPoint: tDecimalPoint;
+ bcdstr: FmtBCDStringtype;
  ar1,ar2: TStringArray;
  st    : psqlite3_stmt;
 
@@ -519,6 +531,27 @@ begin
               if int1 > 0 then 
                  move(sqlite3_column_text(st,fnum)^,buffer^,int1);
               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,
     ftBlob: CreateBlob:=True;
   else { Case }

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

@@ -7,13 +7,13 @@ interface
 uses
   Classes, SysUtils, toolsunit,
   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];
       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] =
         (
@@ -27,7 +27,7 @@ const MySQLdbTypes = [mysql40,mysql41,mysql50,mysql51];
           '',
           'DECIMAL(18,4)',
           'DATE',
-          'TIMESTAMP',
+          'TIME',
           'TIMESTAMP',
           '',
           '',
@@ -42,7 +42,7 @@ const MySQLdbTypes = [mysql40,mysql41,mysql50,mysql51];
           '',
           'CHAR(10)',
           '',
-          '',
+          'BIGINT',
           '',
           '',
           '',
@@ -54,7 +54,7 @@ const MySQLdbTypes = [mysql40,mysql41,mysql50,mysql51];
           '',
           '',
           'TIMESTAMP',
-          '',
+          'NUMERIC(18,6)',
           '',
           ''
         );
@@ -115,8 +115,7 @@ begin
       testStringValues[t] := TrimRight(testStringValues[t]);
     end;
   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
     begin
     Fconnection := TSQLite3Connection.Create(nil);
@@ -134,7 +133,6 @@ begin
   if SQLDbType = INTERBASE then
     begin
     Fconnection := tIBConnection.Create(nil);
-    FieldtypeDefinitions[ftLargeint] := 'BIGINT';
     end;
   if SQLDbType = ODBC then Fconnection := tODBCConnection.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 TestSupportLargeIntFields;
     procedure TestSupportDateFields;
+    procedure TestSupportTimeFields;
     procedure TestSupportCurrencyFields;
     procedure TestSupportBCDFields;
+    procedure TestSupportfmtBCDFields;
     procedure TestSupportFixedStringFields;
 
     procedure TestAppendOnEmptyDataset;
@@ -145,7 +147,7 @@ type
 
 implementation
 
-uses bufdataset, variants, strutils, sqldb;
+uses bufdataset, variants, strutils, sqldb, FmtBCD;
 
 type THackDataLink=class(TdataLink);
 
@@ -1916,6 +1918,31 @@ begin
   ds.close;
 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;
 
 var i          : byte;
@@ -1953,6 +1980,24 @@ begin
   ds.close;
 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;
 var i          : byte;
     ds         : TDataset;

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

@@ -1,6 +1,7 @@
 unit TestFieldTypes;
 
 {$mode objfpc}{$H+}
+{$modeswitch nestedprocvars}
 
 interface
 
@@ -9,10 +10,10 @@ uses
   db;
 
 type
-
-
   TParamProc = procedure(AParam:TParam; 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 }
 
@@ -20,6 +21,9 @@ type
   private
     procedure CreateTableWithFieldType(ADatatype : TFieldType; ASQLTypeDecl : string);
     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 TestSetBlobAsParam(asWhat : integer);
   protected
@@ -99,6 +103,7 @@ type
 
     // Test SQL-field type recognition
     procedure TestSQLClob;
+    procedure TestSQLLargeint;
   end;
 
 implementation
@@ -1386,7 +1391,10 @@ begin
     begin
     with query do
       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;
       close;
       ServerFilter:='ID=21';
@@ -1583,28 +1591,68 @@ begin
     end;
 end;
 
-procedure TTestFieldTypes.TestSQLClob;
+procedure TTestFieldTypes.TestSQLFieldType(ADatatype : TFieldType; ASQLTypeDecl : string; ADataSize: integer; AGetSQLTextProc: TGetSQLTextProc; ACheckFieldValueProc: TCheckFieldValueProc);
 var
   i          : byte;
+  s: string;
 begin
-  CreateTableWithFieldType(ftMemo,'CLOB');
-  TestFieldDeclaration(ftMemo,0);
+  CreateTableWithFieldType(ADatatype,ASQLTypeDecl);
+  TestFieldDeclaration(ADatatype,ADataSize);
 
   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
     begin
     Open;
     for i := 0 to testValuesCount-1 do
       begin
-      AssertEquals(testStringValues[i],fields[0].AsString);
+      ACheckFieldValueProc(fields[0],i);
       Next;
       end;
     close;
     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;
 var ds : TSQLQuery;
 begin

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

@@ -7,7 +7,7 @@ unit ToolsUnit;
 interface
 
 uses
-  Classes, SysUtils, DB, testdecorator;
+  Classes, SysUtils, DB, testdecorator, FmtBCD;
   
 Const MaxDataSet = 35;
   
@@ -95,6 +95,7 @@ const
   testValuesCount = 25;
   testFloatValues : Array[0..testValuesCount-1] of double = (-maxSmallint-1,-maxSmallint,-256,-255,-128,-127,-1,0,1,127,128,255,256,maxSmallint,maxSmallint+1,0.123456,-0.123456,4.35,12.434E7,9.876e-5,123.45678,2.4,3.2,0.4,23);
   testCurrencyValues : Array[0..testValuesCount-1] of currency = (-100,-65.5,-54.34,-43.34,-2.50,-0.2,45.40,0.3,45.4,127,128,255,256,45,0.3,45.4,127,128,255,256,45,1234.56,43.23,43.43,99.88);
+  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);
   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);
@@ -156,6 +157,35 @@ const
     '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,
     dbconnectorname,
     dbconnectorparams,
@@ -255,6 +285,8 @@ begin
   if DBConnectorRefCount>0 then exit;
   testValues[ftString] := testStringValues;
   testValues[ftFixedChar] := testStringValues;
+  testValues[ftTime] := testTimeValues;
+  testValues[ftFMTBcd] := testFmtBCDValues;
   for i := 0 to testValuesCount-1 do
     begin
     testValues[ftFloat,i] := FloatToStr(testFloatValues[i]);

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

@@ -20,7 +20,11 @@
 {$endif fpc}
 
 {$ifndef DYNLOADINGODBC}
+{$IFDEF WINDOWS}
+  {$linklib odbc32}
+{$ELSE}
   {$linklib odbc}
+{$endif} 
 {$endif}
 
 interface
@@ -1711,7 +1715,10 @@ end;
 Function TimeStructToDateTime (B : PSQL_TIME_STRUCT) : TDateTime;
 begin
   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;