Browse Source

--- Merging r20370 into '.':
U packages/fcl-db/src/sqldb/postgres/pqconnection.pp
--- Merging r20382 into '.':
U packages/fcl-db/src/sqldb/interbase/ibconnection.pp
--- Merging r20386 into '.':
U packages/fcl-db/src/sqldb/odbc/odbcconn.pas
--- Merging r20389 into '.':
U packages/fcl-db/src/base/bufdataset_parser.pp
--- Merging r20400 into '.':
U packages/fcl-db/tests/sqldbtoolsunit.pas
--- Merging r20401 into '.':
U packages/fcl-db/tests/testfieldtypes.pas
--- Merging r20402 into '.':
U packages/odbc/src/odbcsql.inc
--- Merging r20403 into '.':
U packages/fcl-db/src/sqldb/mysql/mysqlconn.inc
--- Merging r20404 into '.':
G packages/fcl-db/src/sqldb/odbc/odbcconn.pas
--- Merging r20439 into '.':
U packages/fcl-db/src/base/fields.inc
--- Merging r20453 into '.':
G packages/fcl-db/src/sqldb/odbc/odbcconn.pas
G packages/odbc/src/odbcsql.inc
--- Merging r20454 into '.':
U packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp
--- Merging r20455 into '.':
U packages/fcl-db/src/base/dsparams.inc

# revisions: 20370,20382,20386,20389,20400,20401,20402,20403,20404,20439,20453,20454,20455
------------------------------------------------------------------------
r20370 | marco | 2012-02-17 15:00:27 +0100 (Fri, 17 Feb 2012) | 2 lines
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/postgres/pqconnection.pp

* Patch from Lacak2 for initial Pg interval support.

------------------------------------------------------------------------
------------------------------------------------------------------------
r20382 | marco | 2012-02-20 10:10:49 +0100 (Mon, 20 Feb 2012) | 3 lines
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/interbase/ibconnection.pp

* Patch from Lacak2 for Mantis #18699 Improve numeric formatting for
interbase.

------------------------------------------------------------------------
------------------------------------------------------------------------
r20386 | marco | 2012-02-20 12:25:42 +0100 (Mon, 20 Feb 2012) | 3 lines
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/odbc/odbcconn.pas

* Check autoincrement based on field properties instead of ft-type. This to improve support for autoincrement
types larger than integer. (bigserial). Patch by Lacak2, Mantis #20722

------------------------------------------------------------------------
------------------------------------------------------------------------
r20389 | joost | 2012-02-21 17:32:51 +0100 (Tue, 21 Feb 2012) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/base/bufdataset_parser.pp

* Fixed AV while filtering datasets with null-fields
------------------------------------------------------------------------
------------------------------------------------------------------------
r20400 | marco | 2012-02-22 21:48:31 +0100 (Wed, 22 Feb 2012) | 2 lines
Changed paths:
M /trunk/packages/fcl-db/tests/sqldbtoolsunit.pas

* Fix compilation of sqldbtoolsunit

------------------------------------------------------------------------
------------------------------------------------------------------------
r20401 | marco | 2012-02-22 21:49:25 +0100 (Wed, 22 Feb 2012) | 2 lines
Changed paths:
M /trunk/packages/fcl-db/tests/testfieldtypes.pas

* Improved tests from Lacak2, Mantis #20182

------------------------------------------------------------------------
------------------------------------------------------------------------
r20402 | marco | 2012-02-22 21:53:30 +0100 (Wed, 22 Feb 2012) | 2 lines
Changed paths:
M /trunk/packages/odbc/src/odbcsql.inc

* Fixes date arithmetic before tdatetime epoch. Mantis #21348, patch by Lacak2

------------------------------------------------------------------------
------------------------------------------------------------------------
r20403 | marco | 2012-02-22 21:55:41 +0100 (Wed, 22 Feb 2012) | 2 lines
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/mysql/mysqlconn.inc

* Maps mysql year data type. Mantis #21347, patch by Lacak2.

------------------------------------------------------------------------
------------------------------------------------------------------------
r20404 | marco | 2012-02-22 21:57:43 +0100 (Wed, 22 Feb 2012) | 2 lines
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/odbc/odbcconn.pas

* Added ftcurrency to TODBCConnection.SetParameters. Patch by Lacak2, Mantis 21349

------------------------------------------------------------------------
------------------------------------------------------------------------
r20439 | marco | 2012-02-27 22:45:21 +0100 (Mon, 27 Feb 2012) | 3 lines
Changed paths:
M /trunk/packages/fcl-db/src/base/fields.inc

* Check for empty lookup-field dataset before iterating, Mantis #21383,
Patch by Luis Americo

------------------------------------------------------------------------
------------------------------------------------------------------------
r20453 | marco | 2012-03-01 11:54:54 +0100 (Thu, 01 Mar 2012) | 2 lines
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/odbc/odbcconn.pas
M /trunk/packages/odbc/src/odbcsql.inc

* Patches from Lacak2 changing currency to odbc numeric type, and ftbcd parameters

------------------------------------------------------------------------
------------------------------------------------------------------------
r20454 | marco | 2012-03-01 12:24:17 +0100 (Thu, 01 Mar 2012) | 2 lines
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp

* fix for #21381. Add a default parameter to switch.

------------------------------------------------------------------------
------------------------------------------------------------------------
r20455 | marco | 2012-03-01 12:32:09 +0100 (Thu, 01 Mar 2012) | 2 lines
Changed paths:
M /trunk/packages/fcl-db/src/base/dsparams.inc

* switch currency fields to use "ascurrency" Mantis 21380, patch by Lacak2

------------------------------------------------------------------------

git-svn-id: branches/fixes_2_6@20519 -

marco 13 years ago
parent
commit
886c66bbce

+ 2 - 4
packages/fcl-db/src/base/bufdataset_parser.pp

@@ -181,13 +181,11 @@ end;
 
 procedure TStringFieldVar.Refresh(Buffer: TRecordBuffer);
 var Fieldbuf : TStringFieldBuffer;
-    s        : string;
 begin
   if not FField.DataSet.GetFieldData(FField,@Fieldbuf) then
-    s := ''
+    FFieldVal^:=#0
   else
-    s := Fieldbuf;
-  strcopy(FFieldVal,@s[1]);
+    strcopy(FFieldVal,@Fieldbuf[0]);
 end;
 
 //--TFloatFieldVar-----------------------------------------------------------

+ 5 - 6
packages/fcl-db/src/base/dsparams.inc

@@ -815,9 +815,8 @@ begin
       ftWord     : Field.AsInteger:=AsWord;
       ftInteger,
       ftAutoInc  : Field.AsInteger:=AsInteger;
-      // Need TField.AsCurrency
-      ftCurrency : Field.asFloat:=AsCurrency;
-      ftFloat    : Field.asFloat:=AsFloat;
+      ftCurrency : Field.AsCurrency:=AsCurrency;
+      ftFloat    : Field.AsFloat:=AsFloat;
       ftBoolean  : Field.AsBoolean:=AsBoolean;
       ftBlob,
       ftGraphic..ftTypedBinary,
@@ -853,9 +852,9 @@ begin
       ftWord     : AsWord:=Field.AsInteger;
       ftInteger,
       ftAutoInc  : AsInteger:=Field.AsInteger;
-      // Need TField.AsCurrency
-      ftCurrency : AsCurrency:=Field.asCurrency;
-      ftFloat    : AsFloat:=Field.asFloat;
+      ftBCD,
+      ftCurrency : AsCurrency:=Field.AsCurrency;
+      ftFloat    : AsFloat:=Field.AsFloat;
       ftBoolean  : AsBoolean:=Field.AsBoolean;
       ftBlob,
       ftGraphic..ftTypedBinary,

+ 3 - 2
packages/fcl-db/src/base/fields.inc

@@ -712,10 +712,11 @@ begin
     FLookupDataSet.DisableControls;
     try
       FLookupDataSet.First;
-      repeat
+      while not FLookupDataSet.Eof do
+      begin
         FLookupList.Add(FLookupDataSet.FieldValues[FLookupKeyfields], FLookupDataSet.FieldValues[FLookupResultField]);
         FLookupDataSet.Next;
-      until FLookupDataSet.EOF;
+      end;
     finally
       FLookupDataSet.EnableControls;
     end;

+ 16 - 5
packages/fcl-db/src/sqldb/interbase/ibconnection.pp

@@ -165,7 +165,6 @@ constructor TIBConnection.Create(AOwner : TComponent);
 begin
   inherited;
   FConnOptions := FConnOptions + [sqSupportParams] + [sqEscapeRepeat];
-  FieldNameQuoteChars:=DoubleQuotes;
   FBLobSegmentSize := 65535; //Shows we're using the maximum segment size
   FDialect := -1;
   FDBDialect := -1;
@@ -649,9 +648,14 @@ begin
 end;
 
 procedure TIBConnection.DoConnect;
+const NoQuotes: TQuoteChars = (' ',' ');
 begin
   inherited DoConnect;
-  FDbDialect := GetDBDialect;
+  FDBDialect := GetDBDialect;
+  if Dialect < 3 then
+    FieldNameQuoteChars := NoQuotes
+  else
+    FieldNameQuoteChars := DoubleQuotes;
 end;
 
 procedure TIBConnection.FreeFldBuffers(cursor : TSQLCursor);
@@ -702,10 +706,11 @@ begin
 
       FD := TFieldDef.Create(FieldDefs, FieldDefs.MakeNameUnique(SQLDA^.SQLVar[x].AliasName), TransType,
          TransLen, (SQLDA^.SQLVar[x].sqltype and 1)=0, (x + 1));
-      if TransType = ftBCD then
+      if TransType in [ftBCD, ftFmtBCD] then
         case (SQLDA^.SQLVar[x].sqltype and not 1) of
           SQL_SHORT : FD.precision := 4;
           SQL_LONG  : FD.precision := 9;
+          SQL_DOUBLE,
           SQL_INT64 : FD.precision := 18;
           else FD.precision := SQLDA^.SQLVar[x].SQLLen;
         end;
@@ -945,7 +950,10 @@ begin
             case SQLDA^.SQLVar[x].SQLLen of
               2 : c := PSmallint(CurrBuff)^ / IntPower10(-SQLDA^.SQLVar[x].SQLScale);
               4 : c := PLongint(CurrBuff)^  / IntPower10(-SQLDA^.SQLVar[x].SQLScale);
-              8 : c := PLargeint(CurrBuff)^ / IntPower10(-SQLDA^.SQLVar[x].SQLScale);
+              8 : if Dialect < 3 then
+                    c := PDouble(CurrBuff)^
+                  else
+                    c := PLargeint(CurrBuff)^ / IntPower10(-SQLDA^.SQLVar[x].SQLScale);
               else
                 Result := False; // Just to be sure, in principle this will never happen
             end; {case}
@@ -956,7 +964,10 @@ begin
             case SQLDA^.SQLVar[x].SQLLen of
               2 : AFmtBcd := BcdDivPower10(PSmallint(CurrBuff)^, -SQLDA^.SQLVar[x].SQLScale);
               4 : AFmtBcd := BcdDivPower10(PLongint(CurrBuff)^,  -SQLDA^.SQLVar[x].SQLScale);
-              8 : AFmtBcd := BcdDivPower10(PLargeint(CurrBuff)^, -SQLDA^.SQLVar[x].SQLScale);
+              8 : if Dialect < 3 then
+                    AFmtBcd := PDouble(CurrBuff)^
+                  else
+                    AFmtBcd := BcdDivPower10(PLargeint(CurrBuff)^, -SQLDA^.SQLVar[x].SQLScale);
               else
                 Result := False; // Just to be sure, in principle this will never happen
             end; {case}

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

@@ -560,7 +560,7 @@ begin
       NewType := ftLargeint;
       NewSize := 0;
       end;
-    FIELD_TYPE_TINY, FIELD_TYPE_SHORT:
+    FIELD_TYPE_TINY, FIELD_TYPE_SHORT, FIELD_TYPE_YEAR:
       begin
       NewType := ftSmallint;
       NewSize := 0;
@@ -874,7 +874,7 @@ begin
     exit;
   SetString(Src, Source, Len);
   case AField^.ftype of
-    FIELD_TYPE_TINY, FIELD_TYPE_SHORT:
+    FIELD_TYPE_TINY, FIELD_TYPE_SHORT, FIELD_TYPE_YEAR:
       begin
       if (Src<>'') then
         VS := StrToInt(Src)

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

@@ -322,8 +322,10 @@ var
   TimeVal: SQL_TIME_STRUCT;
   TimeStampVal: SQL_TIMESTAMP_STRUCT;
   BoolVal: byte;
+  NumericVal: SQL_NUMERIC_STRUCT;
   ColumnSize, BufferLength, StrLenOrInd: SQLINTEGER;
   CType, SqlType, DecimalDigits:SQLSMALLINT;
+  APD: SQLHDESC;
 begin
   // Note: it is assumed that AParams is the same as the one passed to PrepareStatement, in the sense that
   //       the parameters have the same order and names
@@ -429,6 +431,16 @@ begin
           SqlType:=SQL_DOUBLE;
           ColumnSize:=15;
         end;
+      ftCurrency, ftBCD:
+        begin
+          NumericVal:=CurrToNumericStruct(AParams[ParamIndex].AsCurrency);
+          PVal:=@NumericVal;
+          Size:=SizeOf(NumericVal);
+          CType:=SQL_C_NUMERIC;
+          SqlType:=SQL_NUMERIC;
+          ColumnSize:=NumericVal.precision;
+          DecimalDigits:=NumericVal.scale;
+        end;
       ftDate:
         begin
           DateVal:=DateTimeToDateStruct(AParams[ParamIndex].AsDate);
@@ -496,6 +508,16 @@ begin
                           PStrLenOrInd),          // StrLen_or_IndPtr
          SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not bind parameter %d.', [i]
        );
+
+    // required by MSSQL:
+    if CType = SQL_C_NUMERIC then
+    begin
+      ODBCCheckResult(
+        SQLGetStmtAttr(ODBCCursor.FSTMTHandle, SQL_ATTR_APP_PARAM_DESC, @APD, 0, nil),
+        SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not get parameter descriptor.'
+      );
+      SQLSetDescRec(APD, i+1, SQL_C_NUMERIC, 0, ColumnSize+2, ColumnSize, DecimalDigits, Buf, nil, nil);
+    end;
   end;
 end;
 
@@ -1135,13 +1157,13 @@ begin
       FieldSize:=dsMaxStringSize-1;
     end
     else
-    if (FieldType in [ftInteger]) and (AutoIncAttr=SQL_FALSE) then //if the column is an autoincrementing column
-                                                                   //any exact numeric type with scale 0 can have identity attr.
-                                                                   //only one column per table can have identity attr.
+    // any exact numeric type with scale 0 can have identity attr.
+    // only one column per table can have identity attr.
+    if (FieldType in [ftInteger,ftLargeInt]) and (AutoIncAttr=SQL_FALSE) then
     begin
       ODBCCheckResult(
-        SQLColAttribute(ODBCCursor.FSTMTHandle, // statement handle
-                        i,                      // column number
+        SQLColAttribute(ODBCCursor.FSTMTHandle,     // statement handle
+                        i,                          // column number
                         SQL_DESC_AUTO_UNIQUE_VALUE, // FieldIdentifier
                         nil,                        // buffer
                         0,                          // buffer size
@@ -1149,7 +1171,7 @@ begin
                         @AutoIncAttr),              // NumericAttribute
         SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not get autoincrement attribute for column %d.',[i]
       );
-      if AutoIncAttr=SQL_TRUE then
+      if (AutoIncAttr=SQL_TRUE) and (FieldType=ftInteger) then
         FieldType:=ftAutoInc;
     end;
 
@@ -1190,7 +1212,7 @@ begin
     end;
 
     // add FieldDef
-    TFieldDef.Create(FieldDefs, FieldDefs.MakeNameUnique(ColName), FieldType, FieldSize, (Nullable=SQL_NO_NULLS) and (FieldType<>ftAutoInc), i);
+    TFieldDef.Create(FieldDefs, FieldDefs.MakeNameUnique(ColName), FieldType, FieldSize, (Nullable=SQL_NO_NULLS) and (AutoIncAttr=SQL_FALSE), i);
   end;
 end;
 
@@ -1206,7 +1228,7 @@ var
   _Type     :SQLSMALLINT; _TypeIndOrLen     :SQLINTEGER;
   OrdinalPos:SQLSMALLINT; OrdinalPosIndOrLen:SQLINTEGER;
   ColName   :string;      ColNameIndOrLen   :SQLINTEGER;
-  AscOrDesc :SQLCHAR;     AscOrDescIndOrLen :SQLINTEGER;
+  AscOrDesc :char;        AscOrDescIndOrLen :SQLINTEGER;
   PKName    :string;      PKNameIndOrLen    :SQLINTEGER;
 const
   DEFAULT_NAME_LEN = 255;

+ 69 - 9
packages/fcl-db/src/sqldb/postgres/pqconnection.pp

@@ -115,6 +115,8 @@ const Oid_Bool     = 16;
       Oid_Money    = 790;
       Oid_Float8   = 701;
       Oid_Unknown  = 705;
+      Oid_MacAddr  = 829;
+      Oid_Inet     = 869;
       Oid_bpchar   = 1042;
       Oid_varchar  = 1043;
       oid_date      = 1082;
@@ -122,6 +124,7 @@ const Oid_Bool     = 16;
       Oid_timeTZ    = 1266;
       Oid_timestamp = 1114;
       Oid_timestampTZ = 1184;
+      Oid_interval  = 1186;
       oid_numeric   = 1700;
       Oid_uuid      = 2950;
 
@@ -416,6 +419,7 @@ begin
     Oid_TimeStamp,
     Oid_TimeStampTZ        : Result := ftDateTime;
     Oid_Date               : Result := ftDate;
+    Oid_Interval,
     Oid_Time,
     Oid_TimeTZ             : Result := ftTime;
     Oid_Bool               : Result := ftBoolean;
@@ -442,6 +446,14 @@ begin
                              Result := ftGuid;
                              Size := 38;
                              end;
+    Oid_MacAddr            : begin
+                             Result := ftFixedChar;
+                             Size := 17;
+                             end;
+    Oid_Inet               : begin
+                             Result := ftString;
+                             Size := 39;
+                             end;
     Oid_Unknown            : Result := ftUnknown;
   else
     Result := ftUnknown;
@@ -729,6 +741,7 @@ end;
 function TPQConnection.LoadField(cursor : TSQLCursor;FieldDef : TfieldDef;buffer : pointer; out CreateBlob : boolean) : boolean;
 
 const NBASE=10000;
+      DAYS_PER_MONTH=30;
 
 type TNumericRecord = record
        Digits : SmallInt;
@@ -736,6 +749,21 @@ type TNumericRecord = record
        Sign   : SmallInt;
        Scale  : Smallint;
      end;
+     TIntervalRec = packed record
+       time  : int64;
+       day   : longint;
+       month : longint;
+     end;
+     TMacAddrRec = packed record
+       a, b, c, d, e, f: byte;
+     end;
+     TInetRec = packed record
+       family : byte;
+       bits   : byte;
+       is_cidr: byte;
+       nb     : byte;
+       ipaddr : array[1..16] of byte;
+     end;
 
 var
   x,i,j         : integer;
@@ -747,6 +775,8 @@ var
   NumericRecord : ^TNumericRecord;
   guid          : TGUID;
   bcd           : TBCD;
+  macaddr       : ^TMacAddrRec;
+  inet          : ^TInetRec;
 
 begin
   Createblob := False;
@@ -784,9 +814,32 @@ begin
           end;
         ftString, ftFixedChar :
           begin
-          li := pqgetlength(res,curtuple,x);
-          if li > dsMaxStringSize then li := dsMaxStringSize;
-          Move(CurrBuff^, Buffer^, li);
+          case PQftype(res, x) of
+            Oid_MacAddr:
+            begin
+              macaddr := Pointer(CurrBuff);
+              li := FormatBuf(Buffer^, FieldDef.Size, '%.2x:%.2x:%.2x:%.2x:%.2x:%.2x', 29,
+                    [macaddr^.a,macaddr^.b,macaddr^.c,macaddr^.d,macaddr^.e,macaddr^.f]);
+            end;
+            Oid_Inet:
+            begin
+              inet := Pointer(CurrBuff);
+              if inet^.nb = 4 then
+                li := FormatBuf(Buffer^, FieldDef.Size, '%d.%d.%d.%d', 11,
+                      [inet^.ipaddr[1],inet^.ipaddr[2],inet^.ipaddr[3],inet^.ipaddr[4]])
+              else if inet^.nb = 16 then
+                li := FormatBuf(Buffer^, FieldDef.Size, '%x%.2x:%x%.2x:%x%.2x:%x%.2x:%x%.2x:%x%.2x:%x%.2x:%x%.2x', 55,
+                      [inet^.ipaddr[1],inet^.ipaddr[2],inet^.ipaddr[3],inet^.ipaddr[4],inet^.ipaddr[5],inet^.ipaddr[6],inet^.ipaddr[7],inet^.ipaddr[8],inet^.ipaddr[9],inet^.ipaddr[10],inet^.ipaddr[11],inet^.ipaddr[12],inet^.ipaddr[13],inet^.ipaddr[14],inet^.ipaddr[15],inet^.ipaddr[16]])
+              else
+                li := 0;
+            end
+            else
+            begin
+              li := pqgetlength(res,curtuple,x);
+              if li > dsMaxStringSize then li := dsMaxStringSize;
+              Move(CurrBuff^, Buffer^, li);
+            end;
+          end;
           pchar(Buffer + li)^ := #0;
           end;
         ftBlob, ftMemo :
@@ -798,15 +851,22 @@ begin
           end;
         ftDateTime, ftTime :
           begin
-          pint64(buffer)^ := BEtoN(pint64(CurrBuff)^);
           dbl := pointer(buffer);
-          if FIntegerDatetimes then dbl^ := pint64(buffer)^/1000000;
-          if FieldDef.DataType = ftDateTime then
-            dbl^ := dbl^ + 3.1558464E+009; // postgres counts seconds elapsed since 1-1-2000
-          dbl^ := dbl^ / 86400;
+          if FIntegerDatetimes then
+            dbl^ := BEtoN(pint64(CurrBuff)^) / 1000000
+          else
+            pint64(dbl)^ := BEtoN(pint64(CurrBuff)^);
+          case PQftype(res, x) of
+            Oid_Timestamp, Oid_TimestampTZ:
+              dbl^ := dbl^ + 3.1558464E+009; // postgres counts seconds elapsed since 1-1-2000
+            Oid_Interval:
+              dbl^ := dbl^ + BEtoN(plongint(CurrBuff+ 8)^) * SecsPerDay
+                           + BEtoN(plongint(CurrBuff+12)^) * SecsPerDay * DAYS_PER_MONTH;
+          end;
+          dbl^ := dbl^ / SecsPerDay;
           // Now convert the mathematically-correct datetime to the
           // illogical windows/delphi/fpc TDateTime:
-          if (dbl^ <= 0) and (frac(dbl^)<0) then
+          if (dbl^ <= 0) and (frac(dbl^) < 0) then
             dbl^ := trunc(dbl^)-2-frac(dbl^);
           end;
         ftBCD, ftFmtBCD:

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

@@ -505,16 +505,15 @@ begin
   Delete(S,1,P);
 end;
 
-Function ParseSQLiteDate(S : ShortString) : TDateTime;
+Function ParseSQLiteDate(S : ShortString;sepc:ansichar=' ') : TDateTime;
 
 Var
   Year, Month, Day : Integer;
-
 begin
  Result:=0;
  If TryStrToInt(NextWord(S,'-'),Year) then
    if TryStrToInt(NextWord(S,'-'),Month) then
-     if TryStrToInt(NextWord(S,'-'),Day) then
+     if TryStrToInt(NextWord(S,sepc),Day) then
         Result:=EncodeDate(Year,Month,Day);
 end;
 
@@ -560,7 +559,7 @@ begin
     else if (Pos(':',S)<>0) then
       TS:=S;
     end;
-  Result:=ComposeDateTime(ParseSQLiteDate(DS),ParseSQLiteTime(TS,False));
+  Result:=ComposeDateTime(ParseSQLiteDate(DS,'-'),ParseSQLiteTime(TS,False));
 end;
 
 function TSQLite3Connection.LoadField(cursor : TSQLCursor;FieldDef : TfieldDef;buffer : pointer; out CreateBlob : boolean) : boolean;

+ 1 - 2
packages/fcl-db/tests/sqldbtoolsunit.pas

@@ -200,8 +200,7 @@ begin
     HostName := dbhostname;
     if length(dbQuoteChars)>1 then
       begin
-      FieldNameQuoteChars[0] := dbQuoteChars[1];
-      FieldNameQuoteChars[1] := dbQuoteChars[2];
+        FieldNameQuoteChars:=dbquotechars;
       end;
     Open;
     end;

+ 37 - 23
packages/fcl-db/tests/testfieldtypes.pas

@@ -275,20 +275,28 @@ procedure TTestFieldTypes.TestNumeric;
 
 const
   testValuesCount = 13;
-  testValues : Array[0..testValuesCount-1] of currency = (-123456.789,-10200,-10000,-1875.25,-10,-0.5,0,0.5,10,1875.25,10000,10200,123456.789);
-  Sizes: array [0..4] of integer = (4,0,3,5,0); //scale
+  testValues4 : Array[0..testValuesCount-1] of currency = (-99.99,-12.34,-10.2,-10,-0.5,-0.01,0,0.01,0.5,10,10.2,12.34,99.99);
+  testValues9 : Array[0..testValuesCount-1] of currency = (-123456.789,-10000,-1875.25,-10,-0.5,-0.001,0,0.001,0.5,10,1875.25,10000,123456.789);
+  FieldTypes: array [0..7] of TFieldType = (ftBCD, ftBCD, ftBCD, ftFmtBCD, ftLargeInt, ftFmtBCD, ftFmtBCD, ftFmtBCD);
+  FieldSizes: array [0..7] of integer = (4,2,3,5,0,3,5,0); //scale
 
 var
-  i          : byte;
-  s          : string;
+  i,d        : integer;
+  s,s4,s9    : string;
+  t          : TFieldType;
 
 begin
   with TSQLDBConnector(DBConnector) do begin
     if SQLDbType = INTERBASE then
-      s := '' //Interbase supports precision up to 18 only
+    begin
+      //Interbase internal storage of exact numeric data types based on precision:
+      // 1-4 (smallint), 5-9 (integer), 10-18 (int64)
+      s := ''; //Interbase supports precision up to 18 only
+      FieldTypes[5] := ftBCD; //ATM TIBConnection incorrectly maps NUMERIC(18,3) to ftBCD
+    end
     else
-      s := ', N4 NUMERIC(19,0)';
-    Connection.ExecuteDirect('create table FPDEV2 (FT NUMERIC(18,4), N1 NUMERIC(18,0), N2 NUMERIC(18,3), N3 NUMERIC(18,5)' + s + ')');
+      s := ', N19_0 NUMERIC(19,0)';
+    Connection.ExecuteDirect('create table FPDEV2 (FT NUMERIC(18,4), N4_2 NUMERIC(4,2), N9_3 NUMERIC(9,3), N9_5 NUMERIC(9,5), N18_0 NUMERIC(18,0), N18_3 NUMERIC(18,3), N18_5 NUMERIC(18,5)' + s + ')');
     Transaction.CommitRetaining;
 
     with Query do
@@ -296,18 +304,20 @@ begin
       SQL.Text := 'select * from FPDEV2';
       Open;
 
-      AssertEquals(sizeof(Currency), Fields[0].DataSize);
-      AssertTrue(Fields[0].DataType=ftBCD);
-      AssertEquals(Sizes[0], Fields[0].Size);
-
-      AssertTrue(Fields[1].DataType in [ftFmtBCD, ftLargeInt]);
-      AssertEquals(Sizes[1], Fields[1].Size);
-
-      for i := 2 to FieldCount-1 do
+      for i := 0 to FieldCount-1 do
       begin
-        AssertEquals(sizeof(TBCD), Fields[i].DataSize);
-        AssertTrue(Fields[i].DataType=ftFmtBCD);
-        AssertEquals(Sizes[i], Fields[i].Size);
+        case Fields[i].DataType of
+          ftBCD:      d := sizeof(Currency);
+          ftFmtBCD:   d := sizeof(TBCD);
+          ftLargeInt: d := sizeof(int64);
+          else        d := 0;
+        end;
+        t := FieldTypes[i];
+        if t = ftLargeInt then t := ftFmtBCD; //acceptable alternative
+
+        AssertEquals(Fields[i].DataSize, d);
+        AssertTrue(Fields[i].DataType in [FieldTypes[i], t]);
+        AssertEquals(Fields[i].Size, FieldSizes[i]);
       end;
 
       Close;
@@ -315,8 +325,9 @@ begin
 
     for i := 0 to testValuesCount-1 do
     begin
-      s :=CurrToStrF(testValues[i],ffFixed,3,DBConnector.FormatSettings);
-      Connection.ExecuteDirect(format('insert into FPDEV2 (FT,N2,N3) values (%s,%s,%s)', [s,s,s]));
+      s4 := CurrToStrF(testValues4[i],ffFixed,2,DBConnector.FormatSettings);
+      s9 := CurrToStrF(testValues9[i],ffFixed,3,DBConnector.FormatSettings);
+      Connection.ExecuteDirect(format('insert into FPDEV2 (N4_2,N9_5,FT,N9_3,N18_3,N18_5) values (%s,%s,%s,%s,%s,%s)', [s4,s4,s9,s9,s9,s9]));
     end;
 
     with Query do
@@ -324,9 +335,12 @@ begin
       Open;
       for i := 0 to testValuesCount-1 do
       begin
-        AssertEquals(testValues[i], Fields[0].AsCurrency);
-        AssertEquals(testValues[i], Fields[2].AsCurrency);
-        AssertEquals(testValues[i], Fields[3].AsCurrency);
+        AssertEquals(testValues4[i], Fields[1].AsCurrency);
+        AssertEquals(testValues4[i], Fields[3].AsCurrency);
+        AssertEquals(testValues9[i], Fields[0].AsCurrency);
+        AssertEquals(testValues9[i], Fields[2].AsCurrency);
+        AssertEquals(testValues9[i], Fields[5].AsCurrency);
+        AssertEquals(testValues9[i], Fields[6].AsCurrency);
         Next;
       end;
       Close;

+ 43 - 3
packages/odbc/src/odbcsql.inc

@@ -61,7 +61,8 @@ uses
 *)
 
 type
-  SQLCHAR      = char;
+  SQLCHAR      = cuchar;
+  SQLSCHAR     = cschar;
   SQLSMALLINT  = csshort;
   SQLUSMALLINT = cushort;
   SQLRETURN    = SQLSMALLINT;
@@ -284,6 +285,13 @@ type
   end;
   PSQL_TIMESTAMP_STRUCT = ^SQL_TIMESTAMP_STRUCT;
 
+  SQL_NUMERIC_STRUCT = packed record
+    precision: SQLCHAR;
+    scale    : SQLSCHAR;
+    sign     : SQLCHAR; // 1 if positive, 0 if negative
+    val      : array[0..15] of SQLCHAR;
+  end;
+
 const
   SQL_NAME_LEN = 128;
 
@@ -1115,6 +1123,15 @@ type   TSQLGetStmtAttr=function (StatementHandle:SQLHSTMT;
            Attribute:SQLINTEGER;Value:SQLPOINTER;
            BufferLength:SQLINTEGER;StringLength:PSQLINTEGER):SQLRETURN;{$ifdef fpc} extdecl {$else} stdcall {$endif};
 
+type   TSQLSetDescField=function (DescriptorHandle:SQLHDESC;
+           RecNumber:SQLSMALLINT; FieldIdentifier:SQLSMALLINT;
+           ValuePtr:SQLPOINTER; BufferLength:SQLINTEGER):SQLRETURN;{$ifdef fpc} extdecl {$else} stdcall {$endif};
+
+type   TSQLSetDescRec=function (DescriptorHandle:SQLHDESC;
+           RecNumber:SQLSMALLINT; DescType, SubType:SQLSMALLINT;
+           Length:SQLINTEGER; Precision, Scale: SQLSMALLINT;
+           DataPtr:SQLPOINTER; StringLengthPtr,IndicatorPtr:PSQLINTEGER):SQLRETURN;{$ifdef fpc} extdecl {$else} stdcall {$endif};
+
 type   tSQLGetInfo=function (ConnectionHandle:SQLHDBC;
            InfoType:SQLUSMALLINT;InfoValue:SQLPOINTER;
            BufferLength:SQLSMALLINT;StringLength:PSQLSMALLINT):SQLRETURN;{$ifdef fpc} extdecl {$else} stdcall {$endif};
@@ -1242,6 +1259,8 @@ var    SQLExtendedFetch:TSQLExtendedFetch;
 var    SQLGetData:TSQLGetData;
 var    SQLSetStmtAttr:TSQLSetStmtAttr;
 var    SQLGetStmtAttr:TSQLGetStmtAttr;
+//var    SQLSetDescField:TSQLSetDescField;
+var    SQLSetDescRec:TSQLSetDescRec;
 var    SQLBulkOperations:TSQLBulkOperations;
 var    SQLPutData:TSQLPutData;
 var    SQLBindCol:TSQLBindCol;
@@ -1525,6 +1544,7 @@ procedure DateTime2TimeStampStruct( var Value:SQL_TIMESTAMP_STRUCT; b:TDateTime)
 Function TimeStampStructToDateTime( B :  PSQL_TIMESTAMP_STRUCT) : TDateTime;
 Function TimeStructToDateTime (B : PSQL_TIME_STRUCT) : TDateTime;
 function DateTimeToTimeStruct(b: TDateTime) : SQL_TIME_STRUCT;
+function CurrToNumericStruct(c: currency): SQL_NUMERIC_STRUCT;
 
 
 {$IFDEF DYNLOADINGODBC}
@@ -1584,6 +1604,8 @@ begin
     pointer(SQLGetData) := GetProcedureAddress(ODBCLibraryHandle,'SQLGetData');
     pointer(SQLSetStmtAttr) := GetProcedureAddress(ODBCLibraryHandle,'SQLSetStmtAttr');
     pointer(SQLGetStmtAttr) := GetProcedureAddress(ODBCLibraryHandle,'SQLGetStmtAttr');
+    //pointer(SQLSetDescField) := GetProcedureAddress(ODBCLibraryHandle,'SQLSetDescField');
+    pointer(SQLSetDescRec) := GetProcedureAddress(ODBCLibraryHandle,'SQLSetDescRec');
     pointer(SQLBulkOperations) := GetProcedureAddress(ODBCLibraryHandle,'SQLBulkOperations');
     pointer(SQLPutData) := GetProcedureAddress(ODBCLibraryHandle,'SQLPutData');
     pointer(SQLBindCol) := GetProcedureAddress(ODBCLibraryHandle,'SQLBindCol');
@@ -1627,6 +1649,8 @@ begin
     SQLGetData := GetProcedureAddress(ODBCLibraryHandle,'SQLGetData');
     SQLSetStmtAttr := GetProcedureAddress(ODBCLibraryHandle,'SQLSetStmtAttr');
     SQLGetStmtAttr := GetProcedureAddress(ODBCLibraryHandle,'SQLGetStmtAttr');
+    //SQLSetDescField := GetProcedureAddress(ODBCLibraryHandle,'SQLSetDescField');
+    SQLSetDescRec := GetProcedureAddress(ODBCLibraryHandle,'SQLSetDescRec');
     SQLBulkOperations := GetProcedureAddress(ODBCLibraryHandle,'SQLBulkOperations');
     SQLPutData := GetProcedureAddress(ODBCLibraryHandle,'SQLPutData');
     SQLBindCol := GetProcedureAddress(ODBCLibraryHandle,'SQLBindCol');
@@ -1709,8 +1733,7 @@ Function TimeStampStructToDateTime( B :  PSQL_TIMESTAMP_STRUCT) : TDateTime;
 
 begin
  With B^ do
-   Result:=EncodeDate(Year,Month,Day)+
-           EncodeTime(Hour,Minute,Second,Fraction div 1000000);
+   Result:=ComposeDateTime(EncodeDate(Year,Month,Day), EncodeTime(Hour,Minute,Second,Fraction div 1000000));
 end;
 
 Function TimeStructToDateTime (B : PSQL_TIME_STRUCT) : TDateTime;
@@ -1732,3 +1755,20 @@ begin
   Result.Second:=w3;
 end;
 
+function CurrToNumericStruct(c: currency): SQL_NUMERIC_STRUCT;
+var n: int64; i: integer;
+begin
+  Result.precision:=18;
+  Result.scale:=4;
+  if c >= 0 then
+    Result.sign:=1
+  else begin
+    Result.sign:=0;
+    c := -c;
+  end;
+  n := int64(c);
+  for i:=0 to 15 do begin
+    Result.val[i] := n and $ff;
+    n := n shr 8;
+  end;
+end;