Ver Fonte

--- Merging r17400 into '.':
U packages/odbc/src/odbcsql.inc
--- Merging r17401 into '.':
U packages/fcl-db/tests/toolsunit.pas
U packages/fcl-db/tests/testfieldtypes.pas
U packages/fcl-db/tests/testdbbasics.pas
U packages/fcl-db/src/sqldb/odbc/odbcconn.pas
--- Merging r17402 into '.':
G packages/odbc/src/odbcsql.inc
--- Merging r17406 into '.':
U packages/fcl-db/src/base/db.pas
--- Merging r17408 into '.':
U packages/fcl-db/src/base/dsparams.inc
--- Merging r17409 into '.':
G packages/fcl-db/tests/toolsunit.pas
G packages/fcl-db/tests/testfieldtypes.pas
G packages/fcl-db/tests/testdbbasics.pas
--- Merging r17411 into '.':
U packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp
--- Merging r17414 into '.':
G packages/fcl-db/src/sqldb/odbc/odbcconn.pas
--- Merging r17415 into '.':
G packages/fcl-db/tests/toolsunit.pas
U packages/fcl-db/tests/sqldbtoolsunit.pas
G packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp
--- Merging r17416 into '.':
G packages/fcl-db/tests/sqldbtoolsunit.pas
U packages/fcl-db/src/sqldb/mysql/mysqlconn.inc
--- Merging r17417 into '.':
G packages/fcl-db/src/sqldb/mysql/mysqlconn.inc
--- Merging r17418 into '.':
U packages/fcl-db/src/sqldb/sqldb.pp
--- Merging r17419 into '.':
U packages/fcl-db/src/sqlite/customsqliteds.pas
--- Merging r17420 into '.':
G packages/fcl-db/tests/toolsunit.pas
--- Merging r17424 into '.':
G packages/fcl-db/tests/toolsunit.pas
G packages/fcl-db/src/sqldb/sqldb.pp
--- Merging r17425 into '.':
G packages/fcl-db/tests/testfieldtypes.pas
G packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp
G packages/fcl-db/src/base/dsparams.inc
G packages/fcl-db/src/base/db.pas
--- Merging r17426 into '.':
G packages/fcl-db/tests/toolsunit.pas
G packages/fcl-db/src/sqldb/sqldb.pp
--- Merging r17427 into '.':
G packages/fcl-db/tests/sqldbtoolsunit.pas
--- Merging r17429 into '.':
U packages/sqlite/src/sqlite3.inc
--- Merging r17432 into '.':
U packages/fcl-db/tests/testbufdatasetstreams.pas
G packages/fcl-db/src/sqldb/odbc/odbcconn.pas

# revisions: 17400,17401,17402,17406,17408,17409,17411,17414,17415,17416,17417,17418,17419,17420,17424,17425,17426,17427,17429,17432
------------------------------------------------------------------------
r17400 | joost | 2011-05-03 22:40:03 +0200 (Tue, 03 May 2011) | 1 line
Changed paths:
M /trunk/packages/odbc/src/odbcsql.inc

* Implemented DateTimeToTimeStruct, patch from Ladislav Karrach, bug #18773
------------------------------------------------------------------------
------------------------------------------------------------------------
r17401 | joost | 2011-05-03 22:59:40 +0200 (Tue, 03 May 2011) | 3 lines
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/odbc/odbcconn.pas
M /trunk/packages/fcl-db/tests/testdbbasics.pas
M /trunk/packages/fcl-db/tests/testfieldtypes.pas
M /trunk/packages/fcl-db/tests/toolsunit.pas

* Patch from Lasislav Karrach to implement ftTime parameter support to odbc+
test, bug #18824

------------------------------------------------------------------------
------------------------------------------------------------------------
r17402 | michael | 2011-05-04 11:07:57 +0200 (Wed, 04 May 2011) | 1 line
Changed paths:
M /trunk/packages/odbc/src/odbcsql.inc

* Added msec precision to TimeStampStructToDateTime (bug ID 19284, patch bu Lacak2
------------------------------------------------------------------------
------------------------------------------------------------------------
r17406 | michael | 2011-05-05 09:18:32 +0200 (Thu, 05 May 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/base/db.pas

* Fixed bug ID #19290
------------------------------------------------------------------------
------------------------------------------------------------------------
r17408 | joost | 2011-05-07 19:31:12 +0200 (Sat, 07 May 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/base/dsparams.inc

* Avoid unnecessary variant casting in TParam.AssignFieldValue, patch from Ladislav Karrach, bug #19015
------------------------------------------------------------------------
------------------------------------------------------------------------
r17409 | joost | 2011-05-07 20:37:55 +0200 (Sat, 07 May 2011) | 2 lines
Changed paths:
M /trunk/packages/fcl-db/tests/testdbbasics.pas
M /trunk/packages/fcl-db/tests/testfieldtypes.pas
M /trunk/packages/fcl-db/tests/toolsunit.pas

* Patch from Ladislav Karrach to fix some locale-test issues
* Removed unnused variables, bug #18763
------------------------------------------------------------------------
------------------------------------------------------------------------
r17411 | joost | 2011-05-08 14:29:42 +0200 (Sun, 08 May 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp

* Allow sqlite time(intervals) > 24 hours
------------------------------------------------------------------------
------------------------------------------------------------------------
r17414 | joost | 2011-05-08 16:44:45 +0200 (Sun, 08 May 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/odbc/odbcconn.pas

* Initialize fractional part of SQL_DATE_STRUCT
------------------------------------------------------------------------
------------------------------------------------------------------------
r17415 | joost | 2011-05-08 16:51:34 +0200 (Sun, 08 May 2011) | 5 lines
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp
M /trunk/packages/fcl-db/tests/sqldbtoolsunit.pas
M /trunk/packages/fcl-db/tests/toolsunit.pas

* Patch from Ladislav Karrach to add msec support to sqlite-time fields,
bug #18840
* Adapted/fixed test for timefields, to allow testing for msec values,
bug #18763

------------------------------------------------------------------------
------------------------------------------------------------------------
r17416 | joost | 2011-05-08 18:32:17 +0200 (Sun, 08 May 2011) | 4 lines
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/mysql/mysqlconn.inc
M /trunk/packages/fcl-db/tests/sqldbtoolsunit.pas

* Fixes datetime values <0
* Fixed time-intervals longer then 24 hours
* Use 'DATETIME' fields in tests, because mysql's 'TIMESTAMPS' are limited

------------------------------------------------------------------------
------------------------------------------------------------------------
r17417 | joost | 2011-05-08 18:34:38 +0200 (Sun, 08 May 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/mysql/mysqlconn.inc

* Fixed typo/compilation in r17416
------------------------------------------------------------------------
------------------------------------------------------------------------
r17418 | joost | 2011-05-09 18:00:03 +0200 (Mon, 09 May 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/sqldb.pp

* Fixed default/mysql ftTime parameter support, bug #18718
------------------------------------------------------------------------
------------------------------------------------------------------------
r17419 | blikblum | 2011-05-09 18:42:51 +0200 (Mon, 09 May 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/sqlite/customsqliteds.pas

* call validate in setfielddata
------------------------------------------------------------------------
------------------------------------------------------------------------
r17420 | joost | 2011-05-09 20:37:14 +0200 (Mon, 09 May 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-db/tests/toolsunit.pas

* Fixed comments
------------------------------------------------------------------------
------------------------------------------------------------------------
r17424 | joost | 2011-05-10 11:06:40 +0200 (Tue, 10 May 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/sqldb.pp
M /trunk/packages/fcl-db/tests/toolsunit.pas

* Simplified formatting of timeinterval strings, bug #18763
------------------------------------------------------------------------
------------------------------------------------------------------------
r17425 | joost | 2011-05-10 11:13:47 +0200 (Tue, 10 May 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/base/db.pas
M /trunk/packages/fcl-db/src/base/dsparams.inc
M /trunk/packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp
M /trunk/packages/fcl-db/tests/testfieldtypes.pas

* Added ftFmtBCD param support, from Ladislav Karrach, bug #18809
------------------------------------------------------------------------
------------------------------------------------------------------------
r17426 | joost | 2011-05-10 12:29:48 +0200 (Tue, 10 May 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/sqldb.pp
M /trunk/packages/fcl-db/tests/toolsunit.pas

* Fixed typo(?) in r17424
------------------------------------------------------------------------
------------------------------------------------------------------------
r17427 | joost | 2011-05-10 14:10:39 +0200 (Tue, 10 May 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-db/tests/sqldbtoolsunit.pas

* Adapted time-field tests for some differences between databases
------------------------------------------------------------------------
------------------------------------------------------------------------
r17429 | michael | 2011-05-11 08:13:54 +0200 (Wed, 11 May 2011) | 1 line
Changed paths:
M /trunk/packages/sqlite/src/sqlite3.inc

Fixed misnamed sqlite3_value_cint (bug ID 19332)
------------------------------------------------------------------------
------------------------------------------------------------------------
r17432 | joost | 2011-05-11 22:51:32 +0200 (Wed, 11 May 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/odbc/odbcconn.pas
M /trunk/packages/fcl-db/tests/testbufdatasetstreams.pas

* Patch from Ladislav Karrach to fix problems when closing TSQLQueries when the connection is not active, bug #17623
------------------------------------------------------------------------

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

marco há 14 anos atrás
pai
commit
5b0cfac4dc

+ 4 - 1
packages/fcl-db/src/base/db.pas

@@ -1130,6 +1130,7 @@ type
     Function GetAsMemo: string;
     Function GetAsString: string;
     Function GetAsVariant: Variant;
+    Function GetAsFMTBCD: TBCD;
     Function GetDisplayName: string; override;
     Function GetIsNull: Boolean;
     Function IsEqual(AValue: TParam): Boolean;
@@ -1147,6 +1148,7 @@ type
     Procedure SetAsTime(const AValue: TDateTime);
     Procedure SetAsVariant(const AValue: Variant);
     Procedure SetAsWord(AValue: LongInt);
+    Procedure SetAsFMTBCD(const AValue: TBCD);
     Procedure SetDataType(AValue: TFieldType);
     Procedure SetText(const AValue: string);
     function GetAsWideString: WideString;
@@ -1179,6 +1181,7 @@ type
     Property AsString : string read GetAsString write SetAsString;
     Property AsTime : TDateTime read GetAsDateTime write SetAsTime;
     Property AsWord : LongInt read GetAsInteger write SetAsWord;
+    Property AsFMTBCD: TBCD read GetAsFMTBCD write SetAsFMTBCD;
     Property Bound : Boolean read FBound write FBound;
     Property Dataset : TDataset Read GetDataset;
     Property IsNull : Boolean read GetIsNull;
@@ -1685,7 +1688,7 @@ type
     property Active: Boolean read FActive;
     property ActiveRecord: Integer read GetActiveRecord write SetActiveRecord;
     property BOF: Boolean read GetBOF;
-    property BufferCount: Integer read FBufferCount write SetBufferCount;
+    property BufferCount: Integer read GetBufferCount write SetBufferCount;
     property DataSet: TDataSet read GetDataSet;
     property DataSource: TDataSource read FDataSource write SetDataSource;
     property DataSourceFixed: Boolean read FDataSourceFixed write FDataSourceFixed;

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

@@ -569,6 +569,14 @@ begin
     Result:=FValue;
 end;
 
+function TParam.GetAsFMTBCD: TBCD;
+begin
+  If IsNull then
+    Result:=0
+  else
+    Result:=VarToBCD(FValue);
+end;
+
 Function TParam.GetDisplayName: string;
 begin
   if (FName<>'') then
@@ -697,7 +705,10 @@ begin
                       FDataType:=ftString;
       varInt64    : FDataType:=ftLargeInt;
     else
-      FDataType:=ftUnknown;
+      if VarIsFmtBCD(Value) then
+        FDataType:=ftFmtBCD
+      else
+        FDataType:=ftUnknown;
     end;
 end;
 
@@ -707,6 +718,11 @@ begin
   FDataType:=ftWord;
 end;
 
+procedure TParam.SetAsFMTBCD(const AValue: TBCD);
+begin
+  FValue:=VarFmtBCDCreate(AValue);
+  FDataType:=ftFMTBcd;
+end;
 
 Procedure TParam.SetDataType(AValue: TFieldType);
 
@@ -804,6 +820,7 @@ begin
       ftDateTime : Field.AsDateTime:=AsDateTime;
       ftBytes,
       ftVarBytes : ; // Todo.
+      ftFmtBCD   : Field.AsBCD:=AsFMTBCD;
     else
       If not (DataType in [ftCursor, ftArray, ftDataset,ftReference]) then
         DatabaseErrorFmt(SBadParamFieldType, [Name], DataSet);
@@ -841,6 +858,7 @@ begin
       ftDateTime : AsDateTime:=Field.AsDateTime;
       ftBytes,
       ftVarBytes : ; // Todo.
+      ftFmtBCD   : AsFMTBCD:=Field.AsBCD;
     else
       If not (DataType in [ftCursor, ftArray, ftDataset,ftReference]) then
         DatabaseErrorFmt(SBadParamFieldType, [Name], DataSet);
@@ -855,15 +873,15 @@ begin
     begin
 
     if (Field.DataType = ftString) and TStringField(Field).FixedChar then
-      DataType := ftFixedChar
+      FDataType := ftFixedChar
     else if (Field.DataType = ftMemo) and (Field.Size > 255) then
-      DataType := ftString
+      FDataType := ftString
     else if (Field.DataType = ftWideString) and TWideStringField(Field).FixedChar then
-      DataType := ftFixedWideChar
+      FDataType := ftFixedWideChar
     else if (Field.DataType = ftWideMemo) and (Field.Size > 255) then
-      DataType := ftWideString
+      FDataType := ftWideString
     else
-      DataType := Field.DataType;
+      FDataType := Field.DataType;
 
     if VarIsNull(AValue) then
       Clear
@@ -938,6 +956,7 @@ begin
         end;
         end;
       end;
+    ftFmtBCD   : PBCD(Buffer)^:=AsFMTBCD;
   else
     If not (DataType in [ftCursor, ftArray, ftDataset,ftReference]) then
       DatabaseErrorFmt(SBadParamFieldType, [Name], DataSet);
@@ -976,6 +995,7 @@ begin
     ftDataSet,
     ftReference,
     ftCursor   : Result:=0;
+    ftFmtBCD   : Result:=SizeOf(TBCD);
   else
     DatabaseErrorFmt(SBadParamFieldType,[Name],DataSet);
   end;
@@ -1057,6 +1077,7 @@ begin
     ftGraphic..ftTypedBinary,
     ftOraBlob,
     ftOraClob  : SetBlobData(Buffer, StrLen(PChar(Buffer)));
+    ftFmtBCD   : AsFMTBCD:=PBCD(Buffer)^;
   else
     DatabaseErrorFmt(SBadParamFieldType,[Name],DataSet);
   end;

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

@@ -175,7 +175,11 @@ Type
 
 implementation
 
-uses dbconst,ctypes,strutils;
+uses
+  dbconst,
+  ctypes,
+  strutils,
+  dateutils;
 
 const
   Mysql_Option_Names : array[mysql_option] of string = ('MYSQL_OPT_CONNECT_TIMEOUT','MYSQL_OPT_COMPRESS',
@@ -777,7 +781,7 @@ begin
     Result := 0
   else
     Result := EncodeDate(EY, EM, ED);
-  Result := Result + EncodeTime(EH, EN, ES, 0);
+  Result := ComposeDateTime(Result,EncodeTime(EH, EN, ES, 0));
 end;
 
 function InternalStrToTime(S: string): TDateTime;
@@ -789,7 +793,7 @@ begin
   EH := StrToInt(Copy(S, 1, 2));
   EM := StrToInt(Copy(S, 4, 2));
   ES := StrToInt(Copy(S, 7, 2));
-  Result := EncodeTime(EH, EM, ES, 0);
+  Result := EncodeTimeInterval(EH, EM, ES, 0);
 end;
 
 function InternalStrToTimeStamp(S: string): TDateTime;

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

@@ -309,6 +309,7 @@ var
   StrVal: string;
   FloatVal: cdouble;
   DateVal: SQL_DATE_STRUCT;
+  TimeVal: SQL_TIME_STRUCT;
   TimeStampVal: SQL_TIMESTAMP_STRUCT;
   BoolVal: byte;
   ColumnSize, BufferLength, StrLenOrInd: SQLINTEGER;
@@ -400,6 +401,15 @@ begin
           SqlType:=SQL_TYPE_DATE;
           ColumnSize:=Size;
         end;
+      ftTime:
+        begin
+          TimeVal:=DateTimeToTimeStruct(AParams[ParamIndex].AsTime);
+          PVal:=@TimeVal;
+          Size:=SizeOf(TimeVal);
+          CType:=SQL_C_TYPE_TIME;
+          SqlType:=SQL_TYPE_TIME;
+          ColumnSize:=Size;
+        end;
       ftDateTime:
         begin
           DateTime2TimeStampStruct(TimeStampVal, AParams[ParamIndex].AsDateTime);
@@ -766,6 +776,9 @@ begin
     end;
     ftDateTime:           // mapped to TDateTimeField
     begin
+      // Seems like not all ODBC-drivers (mysql on Linux) set the fractional part. Initialize
+      // it's value to avoid 'random' data.
+      ODBCTimeStampStruct.Fraction:=0;
       Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_TYPE_TIMESTAMP, @ODBCTimeStampStruct, SizeOf(SQL_TIMESTAMP_STRUCT), @StrLenOrInd);
       if StrLenOrInd<>SQL_NULL_DATA then
       begin
@@ -949,10 +962,11 @@ begin
   ODBCCursor.FBlobStreams.Clear;
 {$ENDIF}
 
-  ODBCCheckResult(
-    SQLFreeStmt(ODBCCursor.FSTMTHandle, SQL_CLOSE),
-    SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not close ODBC statement cursor.'
-  );
+  if ODBCCursor.FSTMTHandle <> SQL_NULL_HSTMT then
+    ODBCCheckResult(
+      SQLFreeStmt(ODBCCursor.FSTMTHandle, SQL_CLOSE),
+      SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not close ODBC statement cursor.'
+    );
 end;
 
 procedure TODBCConnection.AddFieldDefs(cursor: TSQLCursor; FieldDefs: TFieldDefs);

+ 15 - 1
packages/fcl-db/src/sqldb/sqldb.pp

@@ -497,6 +497,18 @@ implementation
 
 uses dbconst, strutils;
 
+function TimeIntervalToString(Time: TDateTime): string;
+var
+  millisecond: word;
+  second     : word;
+  minute     : word;
+  hour       : word;
+begin
+  DecodeTime(Time,hour,minute,second,millisecond);
+  hour := hour + (trunc(Time) * 24);
+  result := Format('%.2d:%.2d:%.2d.%.3d',[hour,minute,second,millisecond]);
+end;
+
 { TSQLConnection }
 
 function TSQLConnection.StrToStatementType(s : string) : TStatementType;
@@ -667,7 +679,8 @@ begin
   else case field.DataType of
     ftString   : Result := '''' + field.asstring + '''';
     ftDate     : Result := '''' + FormatDateTime('yyyy-mm-dd',Field.AsDateTime) + '''';
-    ftDateTime : Result := '''' + FormatDateTime('yyyy-mm-dd hh:mm:ss',Field.AsDateTime) + ''''
+    ftDateTime : Result := '''' + FormatDateTime('yyyy-mm-dd hh:mm:ss',Field.AsDateTime) + '''';
+    ftTime     : Result := QuotedStr(TimeIntervalToString(Field.AsDateTime));
   else
     Result := field.asstring;
   end; {case}
@@ -680,6 +693,7 @@ begin
     ftString   : Result := '''' + param.asstring + '''';
     ftDate     : Result := '''' + FormatDateTime('yyyy-mm-dd',Param.AsDateTime) + '''';
     ftDateTime : Result := '''' + FormatDateTime('yyyy-mm-dd hh:mm:ss',Param.AsDateTime) + '''';
+    ftTime     : Result := QuotedStr(TimeIntervalToString(Param.AsDateTime));
     ftFloat    : Result := '''' + FloatToStr(Param.AsFloat, FSQLServerFormatSettings) + ''''
   else
     Result := Param.asstring;

+ 17 - 6
packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp

@@ -181,6 +181,7 @@ begin
                 do1:= P.asfloat;
                 checkerror(sqlite3_bind_double(fstatement,I,do1));
                 end;
+        ftFMTBcd,
         ftstring,
         ftmemo: begin // According to SQLite documentation, CLOB's (ftMemo) have the Text affinity
                 str1:= p.asstring;
@@ -444,17 +445,23 @@ begin
         Result:=EncodeDate(Year,Month,Day);
 end;
 
-Function ParseSQLiteTime(S : ShortString) : TDateTime;
+Function ParseSQLiteTime(S : ShortString; Interval: boolean) : TDateTime;
 
 Var
-  Hour, Min, Sec : Integer;
+  Hour, Min, Sec, MSec : Integer;
 
 begin
   Result:=0;
   If TryStrToInt(NextWord(S,':'),Hour) then
     if TryStrToInt(NextWord(S,':'),Min) then
-      if TryStrToInt(NextWord(S,':'),Sec) then
-        Result:=EncodeTime(Hour,Min,Sec,0);
+      if TryStrToInt(NextWord(S,'.'),Sec) then
+        begin
+        MSec:=StrToIntDef(S,0);
+        if Interval then
+          Result:=EncodeTimeInterval(Hour,Min,Sec,MSec)
+        else
+          Result:=EncodeTime(Hour,Min,Sec,MSec);
+        end;
 end;
 
 Function ParseSQLiteDateTime(S : String) : TDateTime;
@@ -480,7 +487,7 @@ begin
     else if (Pos(':',S)<>0) then
       TS:=S;
     end;
-  Result:=ComposeDateTime(ParseSQLiteDate(DS),ParseSQLiteTime(TS));
+  Result:=ComposeDateTime(ParseSQLiteDate(DS),ParseSQLiteTime(TS,False));
 end;
 function TSQLite3Connection.LoadField(cursor : TSQLCursor;FieldDef : TfieldDef;buffer : pointer; out CreateBlob : boolean) : boolean;
 
@@ -520,7 +527,11 @@ begin
                begin
                setlength(str1,sqlite3_column_bytes(st,fnum));
                move(sqlite3_column_text(st,fnum)^,str1[1],length(str1));
-               PDateTime(Buffer)^:=ParseSqliteDateTime(str1)
+               case FieldDef.datatype of
+                 ftDateTime: PDateTime(Buffer)^:=ParseSqliteDateTime(str1);
+                 ftDate    : PDateTime(Buffer)^:=ParseSqliteDate(str1);
+                 ftTime    : PDateTime(Buffer)^:=ParseSQLiteTime(str1,true);
+               end; {case}
                end
              else
                Pdatetime(buffer)^:= sqlite3_column_double(st,fnum);

+ 2 - 0
packages/fcl-db/src/sqlite/customsqliteds.pas

@@ -1320,6 +1320,8 @@ begin
 
   if Field.FieldNo >= 0 then
   begin
+    if State in [dsEdit, dsInsert] then
+      Field.Validate(Buffer);
     FieldOffset := Field.FieldNo - 1;
     EditItem := FCacheItem;
   end

+ 20 - 0
packages/fcl-db/tests/sqldbtoolsunit.pas

@@ -114,6 +114,19 @@ begin
     for t := 0 to testValuesCount-1 do
       testStringValues[t] := TrimRight(testStringValues[t]);
     end;
+  if SQLDbType in [mysql41,mysql50,mysql51] then
+    begin
+    // Use 'DATETIME' for datetime-fields in stead of timestamp, because
+    // mysql's timestamps are only valid in the range 1970-2038.
+    // Downside is that fields defined as 'TIMESTAMP' aren't tested
+    FieldtypeDefinitions[ftDateTime] := 'DATETIME';
+    end;
+  if SQLDbType in [odbc,mysql40,mysql41,mysql50,mysql51,interbase] then
+    begin
+    // Some DB's do not support milliseconds in time-fields.
+    for t := 0 to testValuesCount-1 do
+      testTimeValues[t] := copy(testTimeValues[t],1,8)+'.000';
+    end;
   if SQLDbType = MYSQL50 then Fconnection := tMySQL50Connection.Create(nil);
   if SQLDbType = MYSQL51 then Fconnection := tMySQL51Connection.Create(nil);
   if SQLDbType = sqlite3 then
@@ -133,6 +146,13 @@ begin
   if SQLDbType = INTERBASE then
     begin
     Fconnection := tIBConnection.Create(nil);
+    // Firebird does not support time = 24:00:00
+    testTimeValues[2]:='23:00:00.000';
+    end;
+  if SQLDbType in [postgresql,interbase] then
+    begin
+    // Some db's do not support times > 24:00:00
+    testTimeValues[3]:='13:25:15.000';
     end;
   if SQLDbType = ODBC then Fconnection := tODBCConnection.Create(nil);
   if SQLDbType = ORACLE then Fconnection := TOracleConnection.Create(nil);

+ 21 - 0
packages/fcl-db/tests/testbufdatasetstreams.pas

@@ -65,6 +65,7 @@ type
     procedure TestDeleteAllInsertXML;
 
     procedure TestFileNameProperty;
+    procedure TestCloseDatasetNoConnection; // bug 17623
   end;
 
 implementation
@@ -398,6 +399,26 @@ begin
   LoadDs.close;
 end;
 
+procedure TTestBufDatasetStreams.TestCloseDatasetNoConnection;
+var SaveDs: TCustomBufDataset;
+    LoadDs: TCustomBufDataset;
+    Conn: TSQLConnection;
+begin
+  SaveDs := DBConnector.GetNDataset(true,15) as TSQLQuery;
+  SaveDs.Open;
+  SaveDs.SaveToFile('Basics.xml',dfXML);
+  SaveDs.Close;
+
+  Conn := TSQLConnectionClass(TSQLDBConnector(DBConnector).Connection.ClassType).Create(nil);
+  LoadDs := TSQLQuery.Create(nil);
+  LoadDs.DataBase:=Conn;
+  LoadDs.LoadFromFile('Basics.xml');
+  LoadDs.Next;
+  LoadDs.Close;
+  LoadDs.Free;
+  Conn.Free;
+end;
+
 procedure TTestBufDatasetStreams.TestSimpleEditApplUpd;
 begin
   TestChangesApplyUpdates(@SimpleEditChange);

+ 2 - 12
packages/fcl-db/tests/testdbbasics.pas

@@ -1912,7 +1912,7 @@ begin
 
   for i := 0 to testValuesCount-1 do
     begin
-    AssertEquals(testDateValues[i],FormatDateTime('yyyy/mm/dd',Fld.AsDateTime));
+    AssertEquals(testDateValues[i], FormatDateTime('yyyy/mm/dd', Fld.AsDateTime, DBConnector.FormatSettings));
     ds.Next;
     end;
   ds.close;
@@ -1922,22 +1922,12 @@ 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);
+    AssertEquals(testTimeValues[i],DateTimeToTimeString(fld.AsDateTime));
     ds.Next;
     end;
   ds.close;

+ 22 - 12
packages/fcl-db/tests/testfieldtypes.pas

@@ -87,6 +87,8 @@ type
     procedure TestFixedStringParamQuery;
     procedure TestDateParamQuery;
     procedure TestIntParamQuery;
+    procedure TestTimeParamQuery;
+    procedure TestFmtBCDParamQuery;
     procedure TestFloatParamQuery;
     procedure TestBCDParamQuery;
     procedure TestAggregates;
@@ -108,7 +110,7 @@ type
 
 implementation
 
-uses sqldbtoolsunit,toolsunit, variants, sqldb, bufdataset, strutils, dbconst;
+uses sqldbtoolsunit,toolsunit, variants, sqldb, bufdataset, strutils, dbconst, FmtBCD;
 
 Type HackedDataset = class(TDataset);
 
@@ -236,9 +238,6 @@ end;
 
 procedure TTestFieldTypes.TestLargeRecordSize;
 
-var
-  i          : byte;
-
 begin
   TSQLDBConnector(DBConnector).Connection.ExecuteDirect('create table FPDEV2 (plant varchar(8192),sampling_type varchar(8192),area varchar(8192), area_description varchar(8192), batch varchar(8192), sampling_datetime timestamp, status varchar(8192), batch_commentary varchar(8192))');
 
@@ -416,7 +415,7 @@ begin
     Open;
     for i := 0 to testDateValuesCount-1 do
       begin
-      AssertEquals(testDateValues[i],FormatDateTime('yyyy/mm/dd',fields[0].AsDateTime));
+      AssertEquals(testDateValues[i],FormatDateTime('yyyy/mm/dd', fields[0].AsDateTime, DBConnector.FormatSettings));
       Next;
       end;
     close;
@@ -593,9 +592,9 @@ begin
     for i := 0 to corrTestValueCount-1 do
       begin
       if length(testValues[i]) < 12 then
-        AssertEquals(testValues[i],FormatDateTime('yyyy/mm/dd',fields[0].AsDateTime))
+        AssertEquals(testValues[i],FormatDateTime('yyyy/mm/dd', fields[0].AsDateTime, DBConnector.FormatSettings))
       else
-        AssertEquals(testValues[i],FormatDateTime('yyyy/mm/dd hh:mm:ss',fields[0].AsDateTime));
+        AssertEquals(testValues[i],FormatDateTime('yyyy/mm/dd hh:mm:ss', fields[0].AsDateTime, DBConnector.FormatSettings));
       Next;
       end;
     close;
@@ -731,6 +730,16 @@ begin
   TestXXParamQuery(ftInteger,'INT',testIntValuesCount);
 end;
 
+procedure TTestFieldTypes.TestFmtBCDParamQuery;
+begin
+  TestXXParamQuery(ftFMTBcd,FieldtypeDefinitionsConst[ftFMTBcd],testValuesCount);
+end;
+
+procedure TTestFieldTypes.TestTimeParamQuery;
+begin
+  TestXXParamQuery(ftTime,FieldtypeDefinitionsConst[ftTime],testValuesCount);
+end;
+
 procedure TTestFieldTypes.TestFloatParamQuery;
 
 begin
@@ -776,8 +785,6 @@ begin
     sql.clear;
     sql.append('insert into FPDEV2 (ID,FIELD1) values (:id,:field1)');
 
-    ShortDateFormat := 'yyyy-mm-dd';
-
     // There is no Param.AsFixedChar, so the datatype has to be set manually
     if ADatatype=ftFixedChar then
       Params.ParamByName('field1').DataType := ftFixedChar;
@@ -791,10 +798,12 @@ begin
         ftBCD    : Params.ParamByName('field1').AsCurrency:= testBCDValues[i];
         ftFixedChar,
         ftString : Params.ParamByName('field1').AsString  := testStringValues[i];
+        ftTime   : Params.ParamByName('field1').AsTime  := TimeStringToDateTime(testTimeValues[i]);
         ftDate   : if cross then
                      Params.ParamByName('field1').AsString:= testDateValues[i]
                    else
-                     Params.ParamByName('field1').AsDateTime:= StrToDate(testDateValues[i]);
+                     Params.ParamByName('field1').AsDateTime:= StrToDate(testDateValues[i],'yyyy/mm/dd','-');
+        ftFMTBcd : Params.ParamByName('field1').AsFMTBCD:= StrToBCD(testFmtBCDValues[i]{,DBConnector.FormatSettings})
       else
         AssertTrue('no test for paramtype available',False);
       end;
@@ -815,7 +824,9 @@ begin
         ftBCD    : AssertEquals(testBCDValues[i],FieldByName('FIELD1').AsCurrency);
         ftFixedChar : AssertEquals(PadRight(testStringValues[i],10),FieldByName('FIELD1').AsString);
         ftString : AssertEquals(testStringValues[i],FieldByName('FIELD1').AsString);
-        ftdate   : AssertEquals(testDateValues[i],FormatDateTime('yyyy/mm/dd',FieldByName('FIELD1').AsDateTime));
+        ftTime   : AssertEquals(testTimeValues[i],DateTimeToTimeString(FieldByName('FIELD1').AsDateTime));
+        ftdate   : AssertEquals(testDateValues[i],FormatDateTime('yyyy/mm/dd',FieldByName('FIELD1').AsDateTime, DBConnector.FormatSettings));
+        ftFMTBcd : AssertEquals(testFmtBCDValues[i],BCDToStr(FieldByName('FIELD1').AsBCD{,DBConnector.FormatSettings}))
       else
         AssertTrue('no test for paramtype available',False);
       end;
@@ -828,7 +839,6 @@ end;
 
 procedure TTestFieldTypes.TestSetBlobAsParam(asWhat: integer);
 var
-  i             : byte;
   ASQL          : TSQLQuery;
 
 begin

+ 68 - 26
packages/fcl-db/tests/toolsunit.pas

@@ -18,6 +18,7 @@ type
   TDBConnector = class(TPersistent)
      private
        FChangedDatasets : array[0..MaxDataSet] of boolean;
+       FFormatSettings: TFormatSettings;
        FUsedDatasets : TFPList;
        FChangedFieldDataset : boolean;
      protected
@@ -60,6 +61,7 @@ type
        procedure StartTest;
        procedure StopTest;
        property TestUniDirectional: boolean read GetTestUniDirectional write SetTestUniDirectional;
+       property FormatSettings: TFormatSettings read FFormatSettings;
      end;
 
   { TDBBasicsTestSetup }
@@ -158,31 +160,31 @@ const
   );
 
   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'
+    '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.010',
+    '13:55:12.200',
+    '13:46:12.542',
+    '15:35:12.000',
+    '17:25:12.530',
+    '19:45:12.003',
+    '10:54:12.999',
+    '12:25:12.000',
+    '20:15:12.758',
+    '12:25:12.000'
   );
 
 
@@ -202,6 +204,9 @@ var dbtype,
 procedure InitialiseDBConnector;
 procedure FreeDBConnector;
 
+function DateTimeToTimeString(d: tdatetime) : string;
+function TimeStringToDateTime(d: String): TDateTime;
+
 implementation
 
 uses
@@ -214,6 +219,9 @@ begin
   CreateFieldDataset;
   CreateNDatasets;
   FUsedDatasets := TFPList.Create;
+  FFormatSettings.DecimalSeparator:='.';
+  FFormatSettings.DateSeparator:='-';
+  FFormatSettings.TimeSeparator:=':';
 end;
 
 destructor TDBConnector.destroy;
@@ -300,7 +308,7 @@ begin
     testValues[ftCurrency,i] := CurrToStr(testCurrencyValues[i]);
     // DecimalSeparator:='.';
     testValues[ftBCD,i] := CurrToStr(testCurrencyValues[i]);
-    testValues[ftDate,i] := DateToStr(StrToDate(testDateValues[i], 'yyyy/mm/dd', '-'));
+    testValues[ftDate,i] := testDateValues[i];
     end;
 
   if dbconnectorname = '' then raise Exception.Create('There is no db-connector specified');
@@ -318,6 +326,40 @@ begin
     FreeAndNil(DBConnector);
 end;
 
+function DateTimeToTimeString(d: tdatetime): string;
+var
+  millisecond: word;
+  second     : word;
+  minute     : word;
+  hour       : word;
+begin
+  // Format the datetime in the format hh:nn:ss.zzz, where the hours can be bigger then 23.
+  DecodeTime(d,hour,minute,second,millisecond);
+  hour := hour + (trunc(d) * 24);
+  result := Format('%.2d:%.2d:%.2d.%.3d',[hour,minute,second,millisecond]);
+end;
+
+function TimeStringToDateTime(d: String): TDateTime;
+var
+  millisecond: word;
+  second     : word;
+  minute     : word;
+  hour       : word;
+  days       : word;
+begin
+  // Convert the string in the format hh:nn:ss.zzz to a datetime.
+  hour := strtoint(copy(d,1,2));
+  minute := strtoint(copy(d,4,2));
+  second := strtoint(copy(d,7,2));
+  millisecond := strtoint(copy(d,10,3));
+
+  days := hour div 24;
+  hour := hour mod 24;
+
+  result := ComposeDateTime(days,EncodeTime(hour,minute,second,millisecond));
+end;
+
+
 { TTestDataLink }
 
 {$IFDEF FPC}

+ 11 - 2
packages/odbc/src/odbcsql.inc

@@ -1524,6 +1524,7 @@ function DateTimeToDateStruct( b:TDateTime):SQL_DATE_STRUCT;
 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;
 
 
 {$IFDEF DYNLOADINGODBC}
@@ -1709,7 +1710,7 @@ Function TimeStampStructToDateTime( B :  PSQL_TIMESTAMP_STRUCT) : TDateTime;
 begin
  With B^ do
    Result:=EncodeDate(Year,Month,Day)+
-           EncodeTime(Hour,Minute,Second,0);
+           EncodeTime(Hour,Minute,Second,Fraction div 1000000);
 end;
 
 Function TimeStructToDateTime (B : PSQL_TIME_STRUCT) : TDateTime;
@@ -1721,5 +1722,13 @@ begin
     end;
 end;
 
-
+function DateTimeToTimeStruct(b: TDateTime) : SQL_TIME_STRUCT;
+var
+  w1, w2, w3, w4: Word;
+begin
+  DecodeTime(b, w1, w2, w3, w4);
+  Result.Hour:=w1 + Trunc(b)*24;
+  Result.Minute:=w2;
+  Result.Second:=w3;
+end;
 

+ 3 - 3
packages/sqlite/src/sqlite3.inc

@@ -3263,7 +3263,7 @@ const
 ** If the [unprotected sqlite3_value] object returned by
 ** [sqlite3_column_value()] is used in any other way, including calls
 ** to routines like 
-** [sqlite3_value_cint()], [sqlite3_value_text()], or [sqlite3_value_bytes()],
+** [sqlite3_value_int()], [sqlite3_value_text()], or [sqlite3_value_bytes()],
 ** then the behavior is undefined.
 **
 ** These routines attempt to convert the value where appropriate.  For
@@ -3735,11 +3735,11 @@ type
 **          [protected sqlite3_value] object V cinto a floating point value and
 **          returns a copy of that value.
 **
-** {F15115} The [sqlite3_value_cint(V)] interface converts the
+** {F15115} The [sqlite3_value_int(V)] interface converts the
 **          [protected sqlite3_value] object V cinto a 64-bit signed INTEGER and
 **          returns the lower 32 bits of that INTEGER.
 **
-** {F15118} The [sqlite3_value_cint64(V)] interface converts the
+** {F15118} The [sqlite3_value_int64(V)] interface converts the
 **          [protected sqlite3_value] object V cinto a 64-bit signed INTEGER and
 **          returns a copy of that INTEGER.
 **