Browse Source

--- Merging r17545 into '.':
U packages/fcl-db/tests/tcparser.pas
U packages/fcl-db/src/sql/fpsqlparser.pas
--- Merging r17663 into '.':
U packages/odbc/src/odbcsql.inc
--- Merging r17678 into '.':
U packages/fcl-db/src/base/dsparams.inc
--- Merging r17688 into '.':
U packages/fcl-db/tests/sqldbtoolsunit.pas
--- Merging r17703 into '.':
U packages/fcl-db/src/sqldb/interbase/ibconnection.pp
--- Merging r17704 into '.':
U packages/fcl-db/src/base/bufdataset.pas
--- Merging r17705 into '.':
G packages/fcl-db/src/base/bufdataset.pas
--- Merging r17724 into '.':
U packages/fcl-db/src/dbase/dbf_prscore.pas
--- Merging r17728 into '.':
U packages/fcl-db/src/sqldb/sqldb.pp
--- Merging r17729 into '.':
U rtl/objpas/fmtbcd.pp
--- Merging r17730 into '.':
U packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp
--- Merging r17732 into '.':
G packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp
--- Merging r17736 into '.':
U packages/fcl-db/src/sqldb/postgres/pqconnection.pp
--- Merging r17737 into '.':
G packages/fcl-db/src/sqldb/postgres/pqconnection.pp
--- Merging r17738 into '.':
G packages/fcl-db/src/sqldb/sqldb.pp
--- Merging r17739 into '.':
U packages/postgres/src/postgres3dyn.pp
U packages/postgres/src/dllistdyn.pp
--- Merging r17760 into '.':
G packages/fcl-db/src/sqldb/sqldb.pp
--- Merging r17819 into '.':
G packages/fcl-db/src/sqldb/sqldb.pp
--- Merging r17820 into '.':
G packages/postgres/src/postgres3dyn.pp
--- Merging r17821 into '.':
G packages/fcl-db/src/sqldb/postgres/pqconnection.pp
--- Merging r17830 into '.':
G packages/fcl-db/src/sqldb/interbase/ibconnection.pp
--- Merging r17849 into '.':
G packages/fcl-db/src/sqldb/interbase/ibconnection.pp

# revisions: 17545,17663,17678,17688,17703,17704,17705,17724,17728,17729,17730,17732,17736,17737,17738,17739,17760,17819,17820,17821,17830,17849
------------------------------------------------------------------------
r17545 | michael | 2011-05-23 22:36:53 +0200 (Mon, 23 May 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/sql/fpsqlparser.pas
M /trunk/packages/fcl-db/tests/tcparser.pas

* Patch from Dmitry Boyarintsev to support empty statements
------------------------------------------------------------------------
------------------------------------------------------------------------
r17663 | florian | 2011-06-05 12:48:02 +0200 (Sun, 05 Jun 2011) | 1 line
Changed paths:
M /trunk/packages/odbc/src/odbcsql.inc

* $linklib is not needed on windows, commented, resolves #19415
------------------------------------------------------------------------
------------------------------------------------------------------------
r17678 | joost | 2011-06-06 21:43:05 +0200 (Mon, 06 Jun 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/base/dsparams.inc

* Bug #19418
------------------------------------------------------------------------
------------------------------------------------------------------------
r17688 | joost | 2011-06-07 22:07:12 +0200 (Tue, 07 Jun 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-db/tests/sqldbtoolsunit.pas

* Fixed some tests, testValues is already set in InitializeConnection, so has to be adapted also
------------------------------------------------------------------------
------------------------------------------------------------------------
r17703 | michael | 2011-06-09 11:48:10 +0200 (Thu, 09 Jun 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/interbase/ibconnection.pp

* Raise exceptions in case of wrong parameter types for date/float
------------------------------------------------------------------------
------------------------------------------------------------------------
r17704 | michael | 2011-06-09 13:27:51 +0200 (Thu, 09 Jun 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/base/bufdataset.pas

* Fixed test for field is null
------------------------------------------------------------------------
------------------------------------------------------------------------
r17705 | michael | 2011-06-09 14:36:34 +0200 (Thu, 09 Jun 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/base/bufdataset.pas

* Some cleanup of code by LaCak
------------------------------------------------------------------------
------------------------------------------------------------------------
r17724 | marco | 2011-06-12 00:30:00 +0200 (Sun, 12 Jun 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/dbase/dbf_prscore.pas

* int64 support for tdbf indexes. Patch from mantis #16794
------------------------------------------------------------------------
------------------------------------------------------------------------
r17728 | marco | 2011-06-12 15:14:42 +0200 (Sun, 12 Jun 2011) | 3 lines
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/sqldb.pp

* commit patch for various SQL formatting and conversions issues from Mantis #17188 from LacaK2
with some modifications

------------------------------------------------------------------------
------------------------------------------------------------------------
r17729 | marco | 2011-06-12 15:30:03 +0200 (Sun, 12 Jun 2011) | 2 lines
Changed paths:
M /trunk/rtl/objpas/fmtbcd.pp

* Patch from LacaK2 for Mantis #18807 adding of formatsettings variants of BCD conversion routines

------------------------------------------------------------------------
------------------------------------------------------------------------
r17730 | marco | 2011-06-12 15:43:22 +0200 (Sun, 12 Jun 2011) | 3 lines
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp

* cleanup sqlite connection for BCD formatsetting improvements
Patch from LacaK2, mantis #18807 committed as is.

------------------------------------------------------------------------
------------------------------------------------------------------------
r17732 | marco | 2011-06-12 17:34:43 +0200 (Sun, 12 Jun 2011) | 3 lines
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp

* Committed patch from LacaK2 that adds some SQL unicode fieldtypes for sqlite3
Mantis #18670

------------------------------------------------------------------------
------------------------------------------------------------------------
r17736 | marco | 2011-06-13 11:30:46 +0200 (Mon, 13 Jun 2011) | 2 lines
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/postgres/pqconnection.pp

* patch from Mantis #17717 by Lacak2 that improves money,bcd and char types for postgres.

------------------------------------------------------------------------
------------------------------------------------------------------------
r17737 | marco | 2011-06-13 11:38:14 +0200 (Mon, 13 Jun 2011) | 3 lines
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/postgres/pqconnection.pp

* Change ftcurrency to binary field to avoid server<>client locale issues.
Patch from comment in Mantis #17717 by LacaK2

------------------------------------------------------------------------
------------------------------------------------------------------------
r17738 | marco | 2011-06-13 11:43:14 +0200 (Mon, 13 Jun 2011) | 2 lines
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/sqldb.pp

* moved and renamed defaultsqlformatsettings. Related to mantis #17188 (comment 49077)

------------------------------------------------------------------------
------------------------------------------------------------------------
r17739 | marco | 2011-06-13 14:33:04 +0200 (Mon, 13 Jun 2011) | 3 lines
Changed paths:
M /trunk/packages/postgres/src/dllistdyn.pp
M /trunk/packages/postgres/src/postgres3dyn.pp

* postgres initialize routine gets dll path as parameter. Default parameter to old value for compat.
Mantis 17902.

------------------------------------------------------------------------
------------------------------------------------------------------------
r17760 | marco | 2011-06-16 08:43:00 +0200 (Thu, 16 Jun 2011) | 2 lines
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/sqldb.pp

* currency and BSD asCurrency not asFloat. Patch by Lacak2, mantis #19558

------------------------------------------------------------------------
------------------------------------------------------------------------
r17819 | joost | 2011-06-25 00:00:10 +0200 (Sat, 25 Jun 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/sqldb.pp

* Changed DefaultSQLFormatSettings into a constant, because changing this will lead to chaos in the locale-support
------------------------------------------------------------------------
------------------------------------------------------------------------
r17820 | joost | 2011-06-25 00:22:10 +0200 (Sat, 25 Jun 2011) | 2 lines
Changed paths:
M /trunk/packages/postgres/src/postgres3dyn.pp

* Raise exception when PostgreSQL library is already loaded from a different file
* Checked typo in error-message and converted it to a resourcestring
------------------------------------------------------------------------
------------------------------------------------------------------------
r17821 | joost | 2011-06-25 01:25:04 +0200 (Sat, 25 Jun 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/postgres/pqconnection.pp

* Use AsCurrency for currencies instead of float
------------------------------------------------------------------------
------------------------------------------------------------------------
r17830 | joost | 2011-06-25 23:31:41 +0200 (Sat, 25 Jun 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/interbase/ibconnection.pp

* Added FmtBCD support to Firebird
------------------------------------------------------------------------
------------------------------------------------------------------------
r17849 | michael | 2011-06-27 23:50:05 +0200 (Mon, 27 Jun 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/interbase/ibconnection.pp

* Fix for non-i386 platforms
------------------------------------------------------------------------

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

marco 14 years ago
parent
commit
319da534f5

+ 6 - 18
packages/fcl-db/src/base/bufdataset.pas

@@ -1803,30 +1803,18 @@ begin
   if state = dsOldValue then
   if state = dsOldValue then
     begin
     begin
     if not GetActiveRecordUpdateBuffer then
     if not GetActiveRecordUpdateBuffer then
-      begin
-      // There is no old value available
-      result := false;
-      exit;
-      end;
-    currbuff := FUpdateBuffer[FCurrentUpdateBuffer].OldValuesBuffer;
+      Exit; // There is no old value available
+    CurrBuff := FUpdateBuffer[FCurrentUpdateBuffer].OldValuesBuffer;
     end
     end
   else
   else
-    begin
     CurrBuff := GetCurrentBuffer;
     CurrBuff := GetCurrentBuffer;
-    if not assigned(CurrBuff) then
-      begin
-      result := false;
-      exit;
-      end;
-    end;
+
+  if not assigned(CurrBuff) then Exit;
 
 
   If Field.Fieldno > 0 then // If = 0, then calculated field or something similar
   If Field.Fieldno > 0 then // If = 0, then calculated field or something similar
     begin
     begin
-    if GetFieldIsnull(pbyte(CurrBuff),Field.Fieldno-1) then
-      begin
-      result := false;
-      exit;
-      end;
+    if GetFieldIsNull(pbyte(CurrBuff),Field.FieldNo-1) then
+      Exit;
     if assigned(buffer) then
     if assigned(buffer) then
       begin
       begin
       inc(CurrBuff,FFieldBufPositions[Field.FieldNo-1]);
       inc(CurrBuff,FFieldBufPositions[Field.FieldNo-1]);

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

@@ -103,12 +103,9 @@ Function TParams.CreateParam(FldType: TFieldType; const ParamName: string;
 
 
 begin
 begin
   Result:=Add as TParam;
   Result:=Add as TParam;
-  With Result do
-    begin
-    Name:=ParamName;
-    DataType:=FldType;
-    ParamType:=ParamType;
-    end;
+  Result.Name:=ParamName;
+  Result.DataType:=FldType;
+  Result.ParamType:=ParamType;
 end;
 end;
 
 
 Function TParams.FindParam(const Value: string): TParam;
 Function TParams.FindParam(const Value: string): TParam;

+ 3 - 0
packages/fcl-db/src/dbase/dbf_prscore.pas

@@ -2277,6 +2277,9 @@ initialization
     // Functions - name, description, param types, min params, result type, Func addr
     // Functions - name, description, param types, min params, result type, Func addr
     Add(TFunction.Create('STR',       '',      'FII', 1, etString, FuncFloatToStr, ''));
     Add(TFunction.Create('STR',       '',      'FII', 1, etString, FuncFloatToStr, ''));
     Add(TFunction.Create('STR',       '',      'III', 1, etString, FuncIntToStr, ''));
     Add(TFunction.Create('STR',       '',      'III', 1, etString, FuncIntToStr, ''));
+    {$ifdef SUPPORT_INT64}
+     Add(TFunction.Create('STR', '', 'LII', 1, etString, FuncInt64ToStr, ''));
+    {$endif}
     Add(TFunction.Create('DTOS',      '',      'D',   1, etString, FuncDateToStr, ''));
     Add(TFunction.Create('DTOS',      '',      'D',   1, etString, FuncDateToStr, ''));
     Add(TFunction.Create('SUBSTR',    'SUBS',  'SII', 3, etString, FuncSubString, ''));
     Add(TFunction.Create('SUBSTR',    'SUBS',  'SII', 3, etString, FuncSubString, ''));
     Add(TFunction.Create('UPPERCASE', 'UPPER', 'S',   1, etString, FuncUppercase, ''));
     Add(TFunction.Create('UPPERCASE', 'UPPER', 'S',   1, etString, FuncUppercase, ''));

+ 5 - 0
packages/fcl-db/src/sql/fpsqlparser.pas

@@ -3758,6 +3758,10 @@ end;
 
 
 function TSQLParser.Parse: TSQLElement;
 function TSQLParser.Parse: TSQLElement;
 begin
 begin
+  if CurrentToken=tsqlEOF then begin
+    Result:=nil;
+    Exit;
+  end;
   GetNextToken;
   GetNextToken;
   Case CurrentToken of
   Case CurrentToken of
     tsqlSelect : Result:=ParseSelectStatement(Nil,[]);
     tsqlSelect : Result:=ParseSelectStatement(Nil,[]);
@@ -3775,6 +3779,7 @@ begin
     tsqlDeclare : Result:=ParseDeclareStatement(Nil);
     tsqlDeclare : Result:=ParseDeclareStatement(Nil);
     tsqlGrant : Result:=ParseGrantStatement(Nil);
     tsqlGrant : Result:=ParseGrantStatement(Nil);
     tsqlRevoke : Result:=ParseRevokeStatement(Nil);
     tsqlRevoke : Result:=ParseRevokeStatement(Nil);
+    tsqlEOF : Result:=nil;
   else
   else
     UnexpectedToken;
     UnexpectedToken;
   end;
   end;

+ 37 - 2
packages/fcl-db/src/sqldb/interbase/ibconnection.pp

@@ -121,7 +121,7 @@ type
 implementation
 implementation
 
 
 uses
 uses
-  strutils;
+  strutils, FmtBCD;
 
 
 type
 type
   TTm = packed record
   TTm = packed record
@@ -780,7 +780,8 @@ var
   // This should be a pointer, because the ORIGINAL variables must
   // This should be a pointer, because the ORIGINAL variables must
   // be modified.
   // be modified.
   VSQLVar: ^XSQLVAR;
   VSQLVar: ^XSQLVAR;
-
+  d : double;
+  
 begin
 begin
 {$R-}
 {$R-}
   with cursor as TIBCursor do for SQLVarNr := 0 to High(ParamBinding){AParams.count-1} do
   with cursor as TIBCursor do for SQLVarNr := 0 to High(ParamBinding){AParams.count-1} do
@@ -842,6 +843,11 @@ begin
           begin
           begin
             if VSQLVar^.sqlscale = 0 then
             if VSQLVar^.sqlscale = 0 then
               li := AParams[ParNr].AsLargeInt
               li := AParams[ParNr].AsLargeInt
+            else if AParams[ParNr].DataType = ftFMTBcd then
+              begin
+              d:=AParams[ParNr].AsFMTBCD * IntPower(10, -VSQLVar^.sqlscale);
+              li := Round(d)
+              end
             else
             else
               li := Round(AParams[ParNr].AsCurrency * IntPower(10, -VSQLVar^.sqlscale));
               li := Round(AParams[ParNr].AsCurrency * IntPower(10, -VSQLVar^.sqlscale));
             Move(li, VSQLVar^.SQLData^, VSQLVar^.SQLLen);
             Move(li, VSQLVar^.SQLData^, VSQLVar^.SQLLen);
@@ -863,6 +869,7 @@ var
   VarcharLen : word;
   VarcharLen : word;
   CurrBuff     : pchar;
   CurrBuff     : pchar;
   c            : currency;
   c            : currency;
+  AFmtBcd      : tBCD;
   smalli       : smallint;
   smalli       : smallint;
   longi        : longint;
   longi        : longint;
   largei       : largeint;
   largei       : largeint;
@@ -920,6 +927,26 @@ begin
             end; {case}
             end; {case}
             Move(c, buffer^ , sizeof(c));
             Move(c, buffer^ , sizeof(c));
           end;
           end;
+        ftFMTBcd :
+          begin
+            case SQLDA^.SQLVar[x].SQLLen of
+              2 : begin
+                  Move(CurrBuff^, smalli, 2);
+                  AFmtBCD:= smalli*intpower(10,SQLDA^.SQLVar[x].SQLScale);
+                  end;
+              4 : begin
+                  Move(CurrBuff^, longi, 4);
+                  AFmtBcd := longi*intpower(10,SQLDA^.SQLVar[x].SQLScale);
+                  end;
+              8 : begin
+                  Move(CurrBuff^, largei, 8);
+                  AFmtBcd := largei*intpower(10,SQLDA^.SQLVar[x].SQLScale);
+                  end;
+              else
+                Result := False; // Just to be sure, in principle this will never happen
+            end; {case}
+            Move(AFmtBcd, buffer^ , sizeof(AFmtBcd));
+          end;
         ftInteger :
         ftInteger :
           begin
           begin
             FillByte(buffer^,sizeof(Longint),0);
             FillByte(buffer^,sizeof(Longint),0);
@@ -975,6 +1002,8 @@ begin
       isc_decode_sql_time(PISC_TIME(CurrBuff), @CTime);
       isc_decode_sql_time(PISC_TIME(CurrBuff), @CTime);
     SQL_TIMESTAMP :
     SQL_TIMESTAMP :
       isc_decode_timestamp(PISC_TIMESTAMP(CurrBuff), @CTime);
       isc_decode_timestamp(PISC_TIMESTAMP(CurrBuff), @CTime);
+  else
+    Raise EIBDatabaseError.CreateFmt('Invalid parameter type for date Decode : %d',[(AType and not 1)]);
   end;
   end;
 
 
   STime.Year        := CTime.tm_year + 1900;
   STime.Year        := CTime.tm_year + 1900;
@@ -1010,6 +1039,8 @@ begin
       isc_encode_sql_time(@CTime, PISC_TIME(CurrBuff));
       isc_encode_sql_time(@CTime, PISC_TIME(CurrBuff));
     SQL_TIMESTAMP :
     SQL_TIMESTAMP :
       isc_encode_timestamp(@CTime, PISC_TIMESTAMP(CurrBuff));
       isc_encode_timestamp(@CTime, PISC_TIMESTAMP(CurrBuff));
+  else
+    Raise EIBDatabaseError.CreateFmt('Invalid parameter type for date encode : %d',[(AType and not 1)]);
   end;
   end;
 end;
 end;
 
 
@@ -1157,6 +1188,8 @@ begin
         Ext := Dbl;
         Ext := Dbl;
         Move(Ext, CurrBuff^, 10);
         Move(Ext, CurrBuff^, 10);
       end;
       end;
+  else
+    Raise EIBDatabaseError.CreateFmt('Invalid float size for float encode : %d',[Size]);
   end;
   end;
 end;
 end;
 
 
@@ -1181,6 +1214,8 @@ begin
         Move(CurrBuff^, Ext, 10);
         Move(CurrBuff^, Ext, 10);
         Dbl := double(Ext);
         Dbl := double(Ext);
       end;
       end;
+  else
+    Raise EIBDatabaseError.CreateFmt('Invalid float size for float Decode : %d',[Size]);
   end;
   end;
   Move(Dbl, Buffer^, 8);
   Move(Dbl, Buffer^, 8);
 end;
 end;

+ 44 - 22
packages/fcl-db/src/sqldb/postgres/pqconnection.pp

@@ -104,6 +104,7 @@ ResourceString
 
 
 const Oid_Bool     = 16;
 const Oid_Bool     = 16;
       Oid_Bytea    = 17;
       Oid_Bytea    = 17;
+      Oid_char     = 18;
       Oid_Text     = 25;
       Oid_Text     = 25;
       Oid_Oid      = 26;
       Oid_Oid      = 26;
       Oid_Name     = 19;
       Oid_Name     = 19;
@@ -120,6 +121,8 @@ const Oid_Bool     = 16;
       oid_date      = 1082;
       oid_date      = 1082;
       oid_time      = 1083;
       oid_time      = 1083;
       oid_numeric   = 1700;
       oid_numeric   = 1700;
+      Oid_uuid      = 2950;
+
 
 
 constructor TPQConnection.Create(AOwner : TComponent);
 constructor TPQConnection.Create(AOwner : TComponent);
 
 
@@ -420,9 +423,20 @@ begin
                              // The precision is the high 16 bits, the scale the
                              // The precision is the high 16 bits, the scale the
                              // low 16 bits. Both with an offset of 4.
                              // low 16 bits. Both with an offset of 4.
                              // In this case we need the scale:
                              // In this case we need the scale:
+                               begin
                                size := (li-4) and $FFFF;
                                size := (li-4) and $FFFF;
+                               if size > 4 then size:=4; //ftBCD allows max.scale 4, when ftFmtBCD will be implemented then use it
+                               end;
                              end;
                              end;
     Oid_Money              : Result := ftCurrency;
     Oid_Money              : Result := ftCurrency;
+    Oid_char               : begin
+                             Result := ftFixedChar;
+                             Size := 1;
+                             end;
+    Oid_uuid               : begin
+                             Result := ftGuid;
+                             Size := 38;
+                             end;
     Oid_Unknown            : Result := ftUnknown;
     Oid_Unknown            : Result := ftUnknown;
   else
   else
     Result := ftUnknown;
     Result := ftUnknown;
@@ -448,27 +462,17 @@ begin
 end;
 end;
 
 
 procedure TPQConnection.PrepareStatement(cursor: TSQLCursor;ATransaction : TSQLTransaction;buf : string; AParams : TParams);
 procedure TPQConnection.PrepareStatement(cursor: TSQLCursor;ATransaction : TSQLTransaction;buf : string; AParams : TParams);
-{
-  TFieldType = (ftUnknown, ftString, ftSmallint, ftInteger, ftWord,
-      ftBoolean, ftFloat, ftCurrency, ftBCD, ftDate,  ftTime, ftDateTime,
-          ftBytes, ftVarBytes, ftAutoInc, ftBlob, ftMemo, ftGraphic, ftFmtMemo,
-              ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor, ftFixedChar,
-                  ftWideString, ftLargeint, ftADT, ftArray, ftReference,
-                      ftDataSet, ftOraBlob, ftOraClob, ftVariant, ftInterface,
-                          ftIDispatch, ftGuid, ftTimeStamp, ftFMTBcd, ftFixedWideChar, ftWideMemo);
                           
                           
-                          
-}
 const TypeStrings : array[TFieldType] of string =
 const TypeStrings : array[TFieldType] of string =
     (
     (
       'Unknown',   // ftUnknown
       'Unknown',   // ftUnknown
       'text',     // ftString
       'text',     // ftString
-      'int',       // ftSmallint
+      'smallint',  // ftSmallint
       'int',       // ftInteger
       'int',       // ftInteger
       'int',       // ftWord
       'int',       // ftWord
       'bool',      // ftBoolean
       'bool',      // ftBoolean
       'float',     // ftFloat
       'float',     // ftFloat
-      'numeric',   // ftCurrency
+      'money',     // ftCurrency
       'numeric',   // ftBCD
       'numeric',   // ftBCD
       'date',      // ftDate
       'date',      // ftDate
       'time',      // ftTime
       'time',      // ftTime
@@ -484,7 +488,7 @@ const TypeStrings : array[TFieldType] of string =
       'Unknown',   // ftDBaseOle
       'Unknown',   // ftDBaseOle
       'Unknown',   // ftTypedBinary
       'Unknown',   // ftTypedBinary
       'Unknown',   // ftCursor
       'Unknown',   // ftCursor
-      'text',      // ftFixedChar
+      'char',      // ftFixedChar
       'text',      // ftWideString
       'text',      // ftWideString
       'bigint',    // ftLargeint
       'bigint',    // ftLargeint
       'Unknown',   // ftADT
       'Unknown',   // ftADT
@@ -496,9 +500,9 @@ const TypeStrings : array[TFieldType] of string =
       'Unknown',   // ftVariant
       'Unknown',   // ftVariant
       'Unknown',   // ftInterface
       'Unknown',   // ftInterface
       'Unknown',   // ftIDispatch
       'Unknown',   // ftIDispatch
-      'Unknown',   // ftGuid
+      'uuid',      // ftGuid
       'Unknown',   // ftTimeStamp
       'Unknown',   // ftTimeStamp
-      'Unknown',   // ftFMTBcd
+      'numeric',   // ftFMTBcd
       'Unknown',   // ftFixedWideChar
       'Unknown',   // ftFixedWideChar
       'Unknown'    // ftWideMemo
       'Unknown'    // ftWideMemo
     );
     );
@@ -574,11 +578,12 @@ end;
 procedure TPQConnection.Execute(cursor: TSQLCursor;atransaction:tSQLtransaction;AParams : TParams);
 procedure TPQConnection.Execute(cursor: TSQLCursor;atransaction:tSQLtransaction;AParams : TParams);
 
 
 var ar  : array of pchar;
 var ar  : array of pchar;
-    l,i   : integer;
+    l,i : integer;
     s   : string;
     s   : string;
     lengths,formats : array of integer;
     lengths,formats : array of integer;
     ParamNames,
     ParamNames,
     ParamValues : array of string;
     ParamValues : array of string;
+    cash: int64;
 
 
 begin
 begin
   with cursor as TPQCursor do
   with cursor as TPQCursor do
@@ -601,16 +606,22 @@ begin
               s := FormatDateTime('yyyy-mm-dd', AParams[i].AsDateTime);
               s := FormatDateTime('yyyy-mm-dd', AParams[i].AsDateTime);
             ftTime:
             ftTime:
               s := FormatDateTime('hh:nn:ss', AParams[i].AsDateTime);
               s := FormatDateTime('hh:nn:ss', AParams[i].AsDateTime);
-            ftFloat, ftCurrency:
+            ftFloat, ftBCD:
               Str(AParams[i].AsFloat, s);
               Str(AParams[i].AsFloat, s);
+            ftCurrency:
+              begin
+                cash:=NtoBE(round(AParams[i].AsCurrency*100));
+                setlength(s, sizeof(cash));
+                Move(cash, s[1], sizeof(cash));
+              end
             else
             else
               s := AParams[i].AsString;
               s := AParams[i].AsString;
           end; {case}
           end; {case}
           GetMem(ar[i],length(s)+1);
           GetMem(ar[i],length(s)+1);
           StrMove(PChar(ar[i]),Pchar(s),Length(S)+1);
           StrMove(PChar(ar[i]),Pchar(s),Length(S)+1);
           lengths[i]:=Length(s);
           lengths[i]:=Length(s);
-          if (AParams[i].DataType in [ftBlob,ftgraphic]) then
-            formats[i]:=1 
+          if (AParams[i].DataType in [ftBlob,ftGraphic,ftCurrency]) then
+            Formats[i]:=1
           else
           else
             Formats[i]:=0;  
             Formats[i]:=0;  
           end
           end
@@ -710,12 +721,14 @@ type TNumericRecord = record
 
 
 var
 var
   x,i           : integer;
   x,i           : integer;
+  s             : string;
   li            : Longint;
   li            : Longint;
   CurrBuff      : pchar;
   CurrBuff      : pchar;
   tel           : byte;
   tel           : byte;
   dbl           : pdouble;
   dbl           : pdouble;
   cur           : currency;
   cur           : currency;
   NumericRecord : ^TNumericRecord;
   NumericRecord : ^TNumericRecord;
+  guid          : TGUID;
 
 
 begin
 begin
   Createblob := False;
   Createblob := False;
@@ -739,7 +752,7 @@ begin
       result := true;
       result := true;
 
 
       case FieldDef.DataType of
       case FieldDef.DataType of
-        ftInteger, ftSmallint, ftLargeInt,ftfloat :
+        ftInteger, ftSmallint, ftLargeInt, ftFloat :
           begin
           begin
           i := PQfsize(res, x);
           i := PQfsize(res, x);
           case i of               // postgres returns big-endian numbers
           case i of               // postgres returns big-endian numbers
@@ -751,7 +764,7 @@ begin
               pchar(Buffer)[tel-1] := CurrBuff[i-tel];
               pchar(Buffer)[tel-1] := CurrBuff[i-tel];
           end; {case}
           end; {case}
           end;
           end;
-        ftString  :
+        ftString, ftFixedChar :
           begin
           begin
           li := pqgetlength(res,curtuple,x);
           li := pqgetlength(res,curtuple,x);
           if li > dsMaxStringSize then li := dsMaxStringSize;
           if li > dsMaxStringSize then li := dsMaxStringSize;
@@ -802,7 +815,16 @@ begin
           dbl^ := BEtoN(PInt64(CurrBuff)^) / 100;
           dbl^ := BEtoN(PInt64(CurrBuff)^) / 100;
           end;
           end;
         ftBoolean:
         ftBoolean:
-          pchar(buffer)[0] := CurrBuff[0]
+          pchar(buffer)[0] := CurrBuff[0];
+        ftGuid:
+          begin
+          Move(CurrBuff^, guid, sizeof(guid));
+          guid.D1:=BEtoN(guid.D1);
+          guid.D2:=BEtoN(guid.D2);
+          guid.D3:=BEtoN(guid.D3);
+          s:=GUIDToString(guid);
+          StrPLCopy(PChar(Buffer), s, FieldDef.Size);
+          end
         else
         else
           result := false;
           result := false;
       end;
       end;

+ 39 - 8
packages/fcl-db/src/sqldb/sqldb.pp

@@ -96,11 +96,12 @@ type
     FCharSet             : string;
     FCharSet             : string;
     FRole                : String;
     FRole                : String;
 
 
-    FSQLServerFormatSettings : TFormatSettings;
+
     function GetPort: cardinal;
     function GetPort: cardinal;
     procedure Setport(const AValue: cardinal);
     procedure Setport(const AValue: cardinal);
   protected
   protected
     FConnOptions         : TConnOptions;
     FConnOptions         : TConnOptions;
+    FSQLFormatSettings : TFormatSettings;
     procedure GetDBInfo(const ASchemaType : TSchemaType; const ASchemaObjectName, AReturnField : string; AList: TStrings);
     procedure GetDBInfo(const ASchemaType : TSchemaType; const ASchemaObjectName, AReturnField : string; AList: TStrings);
     procedure SetTransaction(Value : TSQLTransaction);virtual;
     procedure SetTransaction(Value : TSQLTransaction);virtual;
     function StrToStatementType(s : string) : TStatementType; virtual;
     function StrToStatementType(s : string) : TStatementType; virtual;
@@ -493,10 +494,34 @@ Procedure UnRegisterConnection(ConnectionName : String);
 Function GetConnectionDef(ConnectorName : String) : TConnectionDef;
 Function GetConnectionDef(ConnectorName : String) : TConnectionDef;
 Procedure GetConnectionList(List : TSTrings);
 Procedure GetConnectionList(List : TSTrings);
 
 
+const DefaultSQLFormatSettings : TFormatSettings = (
+  CurrencyFormat: 1;
+  NegCurrFormat: 5;
+  ThousandSeparator: #0;
+  DecimalSeparator: '.';
+  CurrencyDecimals: 2;
+  DateSeparator: '-';
+  TimeSeparator: ':';
+  ListSeparator: ' ';
+  CurrencyString: '$';
+  ShortDateFormat: 'yyyy-mm-dd';
+  LongDateFormat: '';
+  TimeAMString: '';
+  TimePMString: '';
+  ShortTimeFormat: 'hh:nn:ss';
+  LongTimeFormat: 'hh:nn:ss';
+  ShortMonthNames: ('','','','','','','','','','','','');
+  LongMonthNames: ('','','','','','','','','','','','');
+  ShortDayNames: ('','','','','','','');
+  LongDayNames: ('','','','','','','');
+  TwoDigitYearCenturyWindow: 50;
+);
+
 implementation
 implementation
 
 
 uses dbconst, strutils;
 uses dbconst, strutils;
 
 
+
 function TimeIntervalToString(Time: TDateTime): string;
 function TimeIntervalToString(Time: TDateTime): string;
 var
 var
   millisecond: word;
   millisecond: word;
@@ -649,10 +674,11 @@ begin
   Result := -1;
   Result := -1;
 end;
 end;
 
 
+
 constructor TSQLConnection.Create(AOwner: TComponent);
 constructor TSQLConnection.Create(AOwner: TComponent);
 begin
 begin
   inherited Create(AOwner);
   inherited Create(AOwner);
-  FSQLServerFormatSettings.DecimalSeparator:='.';
+  FSQLFormatSettings:=DefaultSQLFormatSettings;
   FFieldNameQuoteChars:=DoubleQuotes;
   FFieldNameQuoteChars:=DoubleQuotes;
 end;
 end;
 
 
@@ -678,8 +704,8 @@ begin
   if (not assigned(field)) or field.IsNull then Result := 'Null'
   if (not assigned(field)) or field.IsNull then Result := 'Null'
   else case field.DataType of
   else case field.DataType of
     ftString   : Result := '''' + field.asstring + '''';
     ftString   : Result := '''' + field.asstring + '''';
-    ftDate     : Result := '''' + FormatDateTime('yyyy-mm-dd',Field.AsDateTime) + '''';
-    ftDateTime : Result := '''' + FormatDateTime('yyyy-mm-dd hh:mm:ss',Field.AsDateTime) + '''';
+    ftDate     : Result := '''' + FormatDateTime('yyyy-mm-dd',Field.AsDateTime,FSqlFormatSettings) + '''';
+    ftDateTime : Result := '''' + FormatDateTime('yyyy-mm-dd hh:nn:ss',Field.AsDateTime,FSqlFormatSettings) + '''';
     ftTime     : Result := QuotedStr(TimeIntervalToString(Field.AsDateTime));
     ftTime     : Result := QuotedStr(TimeIntervalToString(Field.AsDateTime));
   else
   else
     Result := field.asstring;
     Result := field.asstring;
@@ -690,11 +716,16 @@ function TSQLConnection.GetAsSQLText(Param: TParam) : string;
 begin
 begin
   if (not assigned(param)) or param.IsNull then Result := 'Null'
   if (not assigned(param)) or param.IsNull then Result := 'Null'
   else case param.DataType of
   else case param.DataType of
-    ftString   : Result := '''' + param.asstring + '''';
-    ftDate     : Result := '''' + FormatDateTime('yyyy-mm-dd',Param.AsDateTime) + '''';
-    ftDateTime : Result := '''' + FormatDateTime('yyyy-mm-dd hh:mm:ss',Param.AsDateTime) + '''';
+    ftMemo,
+    ftFixedChar,
+    ftString   : Result := QuotedStr(Param.AsString);
+    ftDate     : Result := '''' + FormatDateTime('yyyy-mm-dd',Param.AsDateTime,FSQLFormatSettings) + '''';
     ftTime     : Result := QuotedStr(TimeIntervalToString(Param.AsDateTime));
     ftTime     : Result := QuotedStr(TimeIntervalToString(Param.AsDateTime));
-    ftFloat    : Result := '''' + FloatToStr(Param.AsFloat, FSQLServerFormatSettings) + ''''
+    ftDateTime : Result := '''' + FormatDateTime('yyyy-mm-dd hh:nn:ss', Param.AsDateTime, FSQLFormatSettings) + '''';
+    ftCurrency,
+    ftBcd      : Result := CurrToStr(Param.AsCurrency, FSQLFormatSettings);
+    ftFloat    : Result := FloatToStr(Param.AsFloat, FSQLFormatSettings);
+    ftFMTBcd   : Result := stringreplace(Param.AsString, DefaultFormatSettings.DecimalSeparator, FSQLFormatSettings.DecimalSeparator, []);
   else
   else
     Result := Param.asstring;
     Result := Param.asstring;
   end; {case}
   end; {case}

+ 53 - 21
packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp

@@ -158,6 +158,7 @@ Var
   cu1: currency;
   cu1: currency;
   do1: double;
   do1: double;
   parms : array of Integer;
   parms : array of Integer;
+  wstr1: widestring;
   
   
 begin
 begin
   for I:=1  to high(fparambinding)+1 do 
   for I:=1  to high(fparambinding)+1 do 
@@ -183,6 +184,7 @@ begin
                 end;
                 end;
         ftFMTBcd,
         ftFMTBcd,
         ftstring,
         ftstring,
+        ftFixedChar,
         ftmemo: begin // According to SQLite documentation, CLOB's (ftMemo) have the Text affinity
         ftmemo: begin // According to SQLite documentation, CLOB's (ftMemo) have the Text affinity
                 str1:= p.asstring;
                 str1:= p.asstring;
                 checkerror(sqlite3_bind_text(fstatement,I,pcharstr(str1), length(str1),@freebindstring));
                 checkerror(sqlite3_bind_text(fstatement,I,pcharstr(str1), length(str1),@freebindstring));
@@ -191,6 +193,11 @@ begin
                 str1:= P.asstring;
                 str1:= P.asstring;
                 checkerror(sqlite3_bind_blob(fstatement,I,pcharstr(str1), length(str1),@freebindstring));
                 checkerror(sqlite3_bind_blob(fstatement,I,pcharstr(str1), length(str1),@freebindstring));
                 end; 
                 end; 
+        ftWideString, ftFixedWideChar, ftWideMemo:
+        begin
+          wstr1:=P.AsWideString;
+          checkerror(sqlite3_bind_text16(fstatement,I, PWideChar(wstr1), length(wstr1)*sizeof(WideChar), sqlite3_destructor_type(SQLITE_TRANSIENT)));
+        end
       else 
       else 
         DatabaseErrorFmt(SUnsupportedParameter, [Fieldtypenames[P.DataType], Self]);
         DatabaseErrorFmt(SUnsupportedParameter, [Fieldtypenames[P.DataType], Self]);
       end; { Case }
       end; { Case }
@@ -259,16 +266,33 @@ var
  int1: integer;
  int1: integer;
  st: psqlite3_stmt;
  st: psqlite3_stmt;
  fnum: integer;
  fnum: integer;
+ p1: Pointer;
 
 
 begin
 begin
   st:=TSQLite3Cursor(cursor).fstatement;
   st:=TSQLite3Cursor(cursor).fstatement;
   fnum:= FieldDef.fieldno - 1;
   fnum:= FieldDef.fieldno - 1;
 
 
-  int1:= sqlite3_column_bytes(st,fnum);
+  case FieldDef.DataType of
+    ftWideMemo:
+      begin
+      p1 := sqlite3_column_text16(st,fnum);
+      int1 := sqlite3_column_bytes16(st,fnum);
+      end;
+    ftMemo:
+      begin
+      p1 := sqlite3_column_text(st,fnum);
+      int1 := sqlite3_column_bytes(st,fnum);
+      end;
+    else //ftBlob
+      begin
+      p1 := sqlite3_column_blob(st,fnum);
+      int1 := sqlite3_column_bytes(st,fnum);
+      end;
+  end;
 
 
-  ReAllocMem(ABlobBuf^.BlobBuffer^.Buffer,int1);
+  ReAllocMem(ABlobBuf^.BlobBuffer^.Buffer, int1);
   if int1 > 0 then
   if int1 > 0 then
-    move(sqlite3_column_text(st,fnum)^,ABlobBuf^.BlobBuffer^.Buffer^,int1);
+    move(p1^, ABlobBuf^.BlobBuffer^.Buffer^, int1);
   ABlobBuf^.BlobBuffer^.Size := int1;
   ABlobBuf^.BlobBuffer^.Size := int1;
 end;
 end;
 
 
@@ -314,7 +338,7 @@ Type
   end;
   end;
   
   
 Const
 Const
-  FieldMapCount = 20;
+  FieldMapCount = 23;
   FieldMap : Array [1..FieldMapCount] of TFieldMap = (
   FieldMap : Array [1..FieldMapCount] of TFieldMap = (
    (n:'INT'; t: ftInteger),
    (n:'INT'; t: ftInteger),
    (n:'LARGEINT'; t:ftlargeInt),
    (n:'LARGEINT'; t:ftlargeInt),
@@ -335,7 +359,10 @@ Const
    (n:'DECIMAL'; t: ftBCD),
    (n:'DECIMAL'; t: ftBCD),
    (n:'TEXT'; t: ftmemo),
    (n:'TEXT'; t: ftmemo),
    (n:'CLOB'; t: ftmemo),
    (n:'CLOB'; t: ftmemo),
-   (n:'BLOB'; t: ftBlob)
+   (n:'BLOB'; t: ftBlob),
+   (n:'NCHAR'; t: ftFixedWideChar),
+   (n:'NVARCHAR'; t: ftWideString),
+   (n:'NCLOB'; t: ftWideMemo)
 { Template:
 { Template:
   (n:''; t: ft)
   (n:''; t: ft)
 }
 }
@@ -378,7 +405,11 @@ begin
     // handle some specials.
     // handle some specials.
     size1:=0;
     size1:=0;
     case ft1 of
     case ft1 of
-      ftString: begin
+      ftString,
+      ftFixedChar,
+      ftFixedWideChar,
+      ftWideString:
+                begin
                 fi:=pos('(',FD);
                 fi:=pos('(',FD);
                 if (fi>0) then
                 if (fi>0) then
                   begin
                   begin
@@ -395,11 +426,11 @@ begin
                   begin
                   begin
                   System.Delete(FD,1,fi);
                   System.Delete(FD,1,fi);
                   fi:=pos(')',FD);
                   fi:=pos(')',FD);
-                  size1:=StrToIntDef(trim(copy(FD,1,fi-1)),255);
+                  size1:=StrToIntDef(trim(copy(FD,1,fi-1)), 0);
                   if size1>4 then
                   if size1>4 then
                     ft1 := ftFMTBcd;
                     ft1 := ftFMTBcd;
                   end
                   end
-                else size1 := 4;
+                else size1 := 0;
                 end;
                 end;
       ftUnknown : DatabaseError('Unknown record type: '+FN);
       ftUnknown : DatabaseError('Unknown record type: '+FN);
     end; // Case
     end; // Case
@@ -494,14 +525,10 @@ function TSQLite3Connection.LoadField(cursor : TSQLCursor;FieldDef : TfieldDef;b
 var
 var
  st1: TStorageType;
  st1: TStorageType;
  fnum: integer;
  fnum: integer;
- i: integer;
- i64: int64;
- int1,int2: integer;
  str1: string;
  str1: string;
+ int1 : integer;
  bcd: tBCD;
  bcd: tBCD;
- StoreDecimalPoint: tDecimalPoint;
  bcdstr: FmtBCDStringtype;
  bcdstr: FmtBCDStringtype;
- ar1,ar2: TStringArray;
  st    : psqlite3_stmt;
  st    : psqlite3_stmt;
 
 
 begin
 begin
@@ -535,6 +562,7 @@ begin
                end
                end
              else
              else
                Pdatetime(buffer)^:= sqlite3_column_double(st,fnum);
                Pdatetime(buffer)^:= sqlite3_column_double(st,fnum);
+    ftFixedChar,
     ftString: begin
     ftString: begin
               int1:= sqlite3_column_bytes(st,fnum);
               int1:= sqlite3_column_bytes(st,fnum);
               if int1>FieldDef.Size then 
               if int1>FieldDef.Size then 
@@ -544,25 +572,30 @@ begin
               end;
               end;
     ftFmtBCD: begin
     ftFmtBCD: begin
               int1:= sqlite3_column_bytes(st,fnum);
               int1:= sqlite3_column_bytes(st,fnum);
-              if int1>255 then
-                int1:=255;
-              if int1 > 0 then
+              if (int1 > 0) and (int1 <= MAXFMTBcdFractionSize) then
                 begin
                 begin
                 SetLength(bcdstr,int1);
                 SetLength(bcdstr,int1);
                 move(sqlite3_column_text(st,fnum)^,bcdstr[1],int1);
                 move(sqlite3_column_text(st,fnum)^,bcdstr[1],int1);
-                StoreDecimalPoint:=FmtBCD.DecimalPoint;
                 // sqlite always uses the point as decimal-point
                 // sqlite always uses the point as decimal-point
-                FmtBCD.DecimalPoint:=DecimalPoint_is_Point;
-                if not TryStrToBCD(bcdstr,bcd) then
+                if not TryStrToBCD(bcdstr,bcd,FSQLFormatSettings) then
                   // sqlite does the same, if the value can't be interpreted as a
                   // sqlite does the same, if the value can't be interpreted as a
                   // number in sqlite3_column_int, return 0
                   // number in sqlite3_column_int, return 0
                   bcd := 0;
                   bcd := 0;
-                FmtBCD.DecimalPoint:=StoreDecimalPoint;
                 end
                 end
               else
               else
                 bcd := 0;
                 bcd := 0;
               pBCD(buffer)^:= bcd;
               pBCD(buffer)^:= bcd;
               end;
               end;
+    ftFixedWideChar,
+    ftWideString:
+      begin
+      int1 := sqlite3_column_bytes16(st,fnum)+2; //The value returned does not include the zero terminator at the end of the string
+      if int1>(FieldDef.Size+1)*2 then
+        int1:=(FieldDef.Size+1)*2;
+      if int1 > 0 then
+        move(sqlite3_column_text16(st,fnum)^, buffer^, int1); //Strings returned by sqlite3_column_text() and sqlite3_column_text16(), even empty strings, are always zero terminated.
+      end;
+    ftWideMemo,
     ftMemo,
     ftMemo,
     ftBlob: CreateBlob:=True;
     ftBlob: CreateBlob:=True;
   else { Case }
   else { Case }
@@ -753,7 +786,6 @@ var
   IndexName: string;
   IndexName: string;
   IndexOptions: TIndexOptions;
   IndexOptions: TIndexOptions;
   PKFields, IXFields: TStrings;
   PKFields, IXFields: TStrings;
-  l: boolean;
 
 
   function CheckPKFields:boolean;
   function CheckPKFields:boolean;
   var i: integer;
   var i: integer;

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

@@ -125,7 +125,10 @@ begin
     begin
     begin
     // Some DB's do not support milliseconds in time-fields.
     // Some DB's do not support milliseconds in time-fields.
     for t := 0 to testValuesCount-1 do
     for t := 0 to testValuesCount-1 do
+      begin
       testTimeValues[t] := copy(testTimeValues[t],1,8)+'.000';
       testTimeValues[t] := copy(testTimeValues[t],1,8)+'.000';
+      testValues[ftTime,t] := copy(testTimeValues[t],1,8)+'.000';
+      end;
     end;
     end;
   if SQLDbType = MYSQL50 then Fconnection := tMySQL50Connection.Create(nil);
   if SQLDbType = MYSQL50 then Fconnection := tMySQL50Connection.Create(nil);
   if SQLDbType = MYSQL51 then Fconnection := tMySQL51Connection.Create(nil);
   if SQLDbType = MYSQL51 then Fconnection := tMySQL51Connection.Create(nil);
@@ -148,11 +151,13 @@ begin
     Fconnection := tIBConnection.Create(nil);
     Fconnection := tIBConnection.Create(nil);
     // Firebird does not support time = 24:00:00
     // Firebird does not support time = 24:00:00
     testTimeValues[2]:='23:00:00.000';
     testTimeValues[2]:='23:00:00.000';
+    testValues[ftTime,2]:='23:00:00.000';
     end;
     end;
   if SQLDbType in [postgresql,interbase] then
   if SQLDbType in [postgresql,interbase] then
     begin
     begin
     // Some db's do not support times > 24:00:00
     // Some db's do not support times > 24:00:00
     testTimeValues[3]:='13:25:15.000';
     testTimeValues[3]:='13:25:15.000';
+    testValues[ftTime,3]:='13:25:15.000';
     end;
     end;
   if SQLDbType = ODBC then Fconnection := tODBCConnection.Create(nil);
   if SQLDbType = ODBC then Fconnection := tODBCConnection.Create(nil);
   if SQLDbType = ORACLE then Fconnection := TOracleConnection.Create(nil);
   if SQLDbType = ORACLE then Fconnection := TOracleConnection.Create(nil);

+ 17 - 1
packages/fcl-db/tests/tcparser.pas

@@ -831,10 +831,25 @@ type
     procedure Test2RolesToUser;
     procedure Test2RolesToUser;
   end;
   end;
 
 
+  { TTestGlobalParser }
+
+  TTestGlobalParser = Class(TTestSQLParser)
+  published
+    procedure TestEmpty;
+  end;
+
 implementation
 implementation
 
 
 uses typinfo;
 uses typinfo;
 
 
+{ TTestGlobalParser }
+
+procedure TTestGlobalParser.TestEmpty;
+begin
+  CreateParser('');
+  AssertNull('Empty statement returns nil',Parser.Parse);
+end;
+
 { --------------------------------------------------------------------
 { --------------------------------------------------------------------
   TTestParser
   TTestParser
   --------------------------------------------------------------------}
   --------------------------------------------------------------------}
@@ -7991,6 +8006,7 @@ initialization
                  TTestCreateTriggerParser,
                  TTestCreateTriggerParser,
                  TTestDeclareExternalFunctionParser,
                  TTestDeclareExternalFunctionParser,
                  TTestGrantParser,
                  TTestGrantParser,
-                 TTestRevokeParser]);
+                 TTestRevokeParser,
+                 TTestGlobalParser]);
 end.
 end.
 
 

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

@@ -21,10 +21,10 @@
 
 
 {$ifndef DYNLOADINGODBC}
 {$ifndef DYNLOADINGODBC}
 {$IFDEF WINDOWS}
 {$IFDEF WINDOWS}
-  {$linklib odbc32}
+  { $linklib odbc32}
 {$ELSE}
 {$ELSE}
   {$linklib odbc}
   {$linklib odbc}
-{$endif} 
+{$endif}
 {$endif}
 {$endif}
 
 
 interface
 interface
@@ -130,7 +130,7 @@ const
   {$if ODBCVER >= $0350}
   {$if ODBCVER >= $0350}
   SQL_GUID       = -11;
   SQL_GUID       = -11;
   {$endif}
   {$endif}
-  
+
   { interval codes}
   { interval codes}
   {$ifdef ODBCVER3}
   {$ifdef ODBCVER3}
   SQL_CODE_YEAR             = 1;
   SQL_CODE_YEAR             = 1;
@@ -175,7 +175,7 @@ const
   SQL_INTERVAL_HOUR_TO_SECOND   = -91;
   SQL_INTERVAL_HOUR_TO_SECOND   = -91;
   SQL_INTERVAL_MINUTE_TO_SECOND = -92;
   SQL_INTERVAL_MINUTE_TO_SECOND = -92;
   {$endif}
   {$endif}
-  
+
   { Unicode data type codes }
   { Unicode data type codes }
   {$ifndef ODBCVER3}
   {$ifndef ODBCVER3}
   SQL_UNICODE             = -95;
   SQL_UNICODE             = -95;
@@ -240,7 +240,7 @@ const
   SQL_C_USHORT   =  SQL_C_SHORT+SQL_UNSIGNED_OFFSET; // UNSIGNED SMALLINT
   SQL_C_USHORT   =  SQL_C_SHORT+SQL_UNSIGNED_OFFSET; // UNSIGNED SMALLINT
   SQL_C_UTINYINT =  SQL_TINYINT+SQL_UNSIGNED_OFFSET; // UNSIGNED TINYINT
   SQL_C_UTINYINT =  SQL_TINYINT+SQL_UNSIGNED_OFFSET; // UNSIGNED TINYINT
   SQL_C_BOOKMARK = SQL_C_ULONG; // BOOKMARK
   SQL_C_BOOKMARK = SQL_C_ULONG; // BOOKMARK
-  
+
 {$ifdef ODBCVER35}
 {$ifdef ODBCVER35}
   SQL_C_GUID    = SQL_GUID;
   SQL_C_GUID    = SQL_GUID;
 {$endif}
 {$endif}
@@ -514,7 +514,7 @@ const
   SQL_USE_BOOKMARKS           =12;
   SQL_USE_BOOKMARKS           =12;
   SQL_GET_BOOKMARK            =13;      //      GetStmtOption Only */
   SQL_GET_BOOKMARK            =13;      //      GetStmtOption Only */
   SQL_ROW_NUMBER              = 14;     //      GetStmtOption Only */
   SQL_ROW_NUMBER              = 14;     //      GetStmtOption Only */
-  
+
   SQL_ATTR_CURSOR_TYPE        = SQL_CURSOR_TYPE;
   SQL_ATTR_CURSOR_TYPE        = SQL_CURSOR_TYPE;
   SQL_ATTR_CONCURRENCY        = SQL_CONCURRENCY;
   SQL_ATTR_CONCURRENCY        = SQL_CONCURRENCY;
   SQL_ATTR_FETCH_BOOKMARK_PTR = 16;
   SQL_ATTR_FETCH_BOOKMARK_PTR = 16;
@@ -1055,7 +1055,7 @@ type   TSQLGetDiagRec=function (HandleType:SQLSMALLINT;
            Sqlstate:PSQLCHAR;var NativeError:SQLINTEGER;
            Sqlstate:PSQLCHAR;var NativeError:SQLINTEGER;
            MessageText:PSQLCHAR;BufferLength:SQLSMALLINT;
            MessageText:PSQLCHAR;BufferLength:SQLSMALLINT;
            var TextLength:SQLSMALLINT ):SQLRETURN;{$ifdef fpc} extdecl {$else} stdcall {$endif};
            var TextLength:SQLSMALLINT ):SQLRETURN;{$ifdef fpc} extdecl {$else} stdcall {$endif};
-           
+
 type   TSQLGetDiagField=function (HandleType:SQLSMALLINT;
 type   TSQLGetDiagField=function (HandleType:SQLSMALLINT;
            Handle:SQLHANDLE;RecNumber:SQLSMALLINT;
            Handle:SQLHANDLE;RecNumber:SQLSMALLINT;
            DiagIdentifier:SQLSMALLINT;DiagInfoPtr:SQLPOINTER;
            DiagIdentifier:SQLSMALLINT;DiagInfoPtr:SQLPOINTER;
@@ -1548,7 +1548,7 @@ begin
   inc(RefCount);
   inc(RefCount);
   if RefCount = 1 then
   if RefCount = 1 then
     begin
     begin
-    if OverrideName='' then 
+    if OverrideName='' then
        libname:=odbclib
        libname:=odbclib
      else
      else
        libname:=OverrideName;
        libname:=OverrideName;

+ 4 - 4
packages/postgres/src/dllistdyn.pp

@@ -43,7 +43,7 @@ var
 { Macro translated }
 { Macro translated }
 Function  DLE_VAL(elem : PDlelem) : pointer;
 Function  DLE_VAL(elem : PDlelem) : pointer;
 
 
-Procedure InitialiseDllist;
+Procedure InitialiseDllist(libpath:string=pqlib);
 Procedure ReleaseDllist;
 Procedure ReleaseDllist;
 
 
 var DllistLibraryHandle : TLibHandle;
 var DllistLibraryHandle : TLibHandle;
@@ -52,17 +52,17 @@ implementation
 
 
 var RefCount : integer;
 var RefCount : integer;
 
 
-Procedure InitialiseDllist;
+Procedure InitialiseDllist(libpath:string=pqlib);
 
 
 begin
 begin
   inc(RefCount);
   inc(RefCount);
   if RefCount = 1 then
   if RefCount = 1 then
     begin
     begin
-    DllistLibraryHandle := loadlibrary(pqlib);
+    DllistLibraryHandle := loadlibrary(libpath);
     if DllistLibraryHandle = nilhandle then
     if DllistLibraryHandle = nilhandle then
       begin
       begin
       RefCount := 0;
       RefCount := 0;
-      Raise EInOutError.Create('Can not load PosgreSQL client. Is it installed? ('+pqlib+')');
+      Raise EInOutError.Create('Can not load PosgreSQL client. Is it installed? ('+libpath+')');
       end;
       end;
 
 
     pointer(DLNewList) := GetProcedureAddress(DllistLibraryHandle,'DLNewList');
     pointer(DLNewList) := GetProcedureAddress(DllistLibraryHandle,'DLNewList');

+ 19 - 6
packages/postgres/src/postgres3dyn.pp

@@ -209,7 +209,7 @@ var
 { Get encoding id from environment variable PGCLIENTENCODING  }
 { Get encoding id from environment variable PGCLIENTENCODING  }
   PQenv2encoding: function :longint;cdecl;
   PQenv2encoding: function :longint;cdecl;
 
 
-Procedure InitialisePostgres3;
+Procedure InitialisePostgres3(libpath:string=pqlib);
 Procedure ReleasePostgres3;
 Procedure ReleasePostgres3;
 
 
 function PQsetdb(M_PGHOST,M_PGPORT,M_PGOPT,M_PGTTY,M_DBNAME : pchar) : ppgconn;
 function PQsetdb(M_PGHOST,M_PGPORT,M_PGOPT,M_PGTTY,M_DBNAME : pchar) : ppgconn;
@@ -218,21 +218,28 @@ var Postgres3LibraryHandle : TLibHandle;
 
 
 implementation
 implementation
 
 
-var RefCount : integer;
+resourcestring
+  SErrLoadFailed     = 'Can not load PostgreSQL client library "%s". Check your installation.';
+  SErrAlreadyLoaded  = 'PostgreSQL interface already initialized from library %s.';
 
 
-Procedure InitialisePostgres3;
+var
+  RefCount : integer;
+  LoadedLibrary : String;
+
+Procedure InitialisePostgres3(libpath:string=pqlib);
 
 
 begin
 begin
   inc(RefCount);
   inc(RefCount);
   if RefCount = 1 then
   if RefCount = 1 then
     begin
     begin
-    Postgres3LibraryHandle := loadlibrary(pqlib);
+    Postgres3LibraryHandle := loadlibrary(libpath);
     if Postgres3LibraryHandle = nilhandle then
     if Postgres3LibraryHandle = nilhandle then
       begin
       begin
       RefCount := 0;
       RefCount := 0;
-      Raise EInOutError.Create('Can not load PosgreSQL client. Is it installed? ('+pqlib+')');
+      Raise EInOutError.CreateFmt(SErrLoadFailed,[libpath]);
       end;
       end;
 
 
+    LoadedLibrary:=libpath;
     pointer(PQconnectStart) := GetProcedureAddress(Postgres3LibraryHandle,'PQconnectStart');
     pointer(PQconnectStart) := GetProcedureAddress(Postgres3LibraryHandle,'PQconnectStart');
     pointer(PQconnectPoll) := GetProcedureAddress(Postgres3LibraryHandle,'PQconnectPoll');
     pointer(PQconnectPoll) := GetProcedureAddress(Postgres3LibraryHandle,'PQconnectPoll');
     pointer(PQconnectdb) := GetProcedureAddress(Postgres3LibraryHandle,'PQconnectdb');
     pointer(PQconnectdb) := GetProcedureAddress(Postgres3LibraryHandle,'PQconnectdb');
@@ -336,7 +343,13 @@ begin
     pointer(PQenv2encoding) := GetProcedureAddress(Postgres3LibraryHandle,'PQenv2encoding');
     pointer(PQenv2encoding) := GetProcedureAddress(Postgres3LibraryHandle,'PQenv2encoding');
 
 
     InitialiseDllist;
     InitialiseDllist;
-    end;
+    end
+  else
+    if (libpath<>pqlib) and (LoadedLibrary<>libpath) then
+      begin
+      Dec(RefCount);
+      Raise EInOUtError.CreateFmt(SErrAlreadyLoaded,[LoadedLibrary]);
+      end;
 end;
 end;
 
 
 Procedure ReleasePostgres3;
 Procedure ReleasePostgres3;

+ 45 - 59
rtl/objpas/fmtbcd.pp

@@ -223,17 +223,12 @@ INTERFACE
                             { BCD Nibbles, 00..99 per Byte, high Nibble 1st }
                             { BCD Nibbles, 00..99 per Byte, high Nibble 1st }
             end;
             end;
 
 
-  type
-    tDecimalPoint = ( DecimalPoint_is_Point, DecimalPoint_is_Comma, DecimalPoint_is_System );
-
 { Exception classes }
 { Exception classes }
   type
   type
     eBCDException = CLASS ( Exception );
     eBCDException = CLASS ( Exception );
     eBCDOverflowException = CLASS ( eBCDException );
     eBCDOverflowException = CLASS ( eBCDException );
     eBCDNotImplementedException = CLASS ( eBCDException );
     eBCDNotImplementedException = CLASS ( eBCDException );
 
 
-  var
-    DecimalPoint : tDecimalPoint = DecimalPoint_is_System;
 
 
 { Utility functions for TBCD access }
 { Utility functions for TBCD access }
 
 
@@ -326,9 +321,16 @@ INTERFACE
 { Convert string/Double/Integer to BCD struct }
 { Convert string/Double/Integer to BCD struct }
   function StrToBCD ( const aValue : FmtBCDStringtype ) : tBCD;
   function StrToBCD ( const aValue : FmtBCDStringtype ) : tBCD;
 
 
+  function StrToBCD ( const aValue : FmtBCDStringtype;
+                            const Format : TFormatSettings ) : tBCD;
+
   function TryStrToBCD ( const aValue : FmtBCDStringtype;
   function TryStrToBCD ( const aValue : FmtBCDStringtype;
                            var BCD : tBCD ) : Boolean;
                            var BCD : tBCD ) : Boolean;
 
 
+  function TryStrToBCD ( const aValue : FmtBCDStringtype;
+                           var BCD : tBCD;
+                               const Format : TFormatSettings) : Boolean;
+
 {$ifndef FPUNONE}
 {$ifndef FPUNONE}
   function DoubleToBCD ( const aValue : myRealtype ) : tBCD; Inline;
   function DoubleToBCD ( const aValue : myRealtype ) : tBCD; Inline;
 
 
@@ -349,6 +351,9 @@ INTERFACE
 { Convert BCD struct to string/Double/Integer }
 { Convert BCD struct to string/Double/Integer }
   function BCDToStr ( const BCD : tBCD ) : FmtBCDStringtype;
   function BCDToStr ( const BCD : tBCD ) : FmtBCDStringtype;
 
 
+  function BCDToStr ( const BCD : tBCD;
+                            const Format : TFormatSettings ) : FmtBCDStringtype;
+
 {$ifndef FPUNONE}
 {$ifndef FPUNONE}
   function BCDToDouble ( const BCD : tBCD ) : myRealtype;
   function BCDToDouble ( const BCD : tBCD ) : myRealtype;
 {$endif}
 {$endif}
@@ -1201,27 +1206,6 @@ IMPLEMENTATION
       pack_BCD := True;
       pack_BCD := True;
      end;
      end;
 
 
-  procedure SetDecimals ( out dp,
-                              dc : Char );
-
-    begin
-      case DecimalPoint of
-        DecimalPoint_is_Point: begin
-                                 dp := '.';
-                                 dc := ',';
-                                end;
-        DecimalPoint_is_Comma: begin
-                                 dp := ',';
-                                 dc := '.';
-                                end;
-{ find out language-specific ? }
-        DecimalPoint_is_System: begin
-                                 dp := DefaultFormatSettings.DecimalSeparator;
-                                 dc := DefaultFormatSettings.ThousandSeparator;
-                                end;
-       end;
-     end;
-
   function BCDPrecision ( const BCD : tBCD ) : Word; Inline;
   function BCDPrecision ( const BCD : tBCD ) : Word; Inline;
 
 
     begin
     begin
@@ -1373,9 +1357,13 @@ IMPLEMENTATION
 
 
   function TryStrToBCD ( const aValue : FmtBCDStringtype;
   function TryStrToBCD ( const aValue : FmtBCDStringtype;
                            var BCD : tBCD ) : Boolean;
                            var BCD : tBCD ) : Boolean;
+  begin
+    Result := TryStrToBCD(aValue, BCD, DefaultFormatSettings);
+  end;
 
 
-{ shall this return TRUE when error and FALSE when o.k. or the other way round ? }
-
+  function TryStrToBCD ( const aValue : FmtBCDStringtype;
+                           var BCD : tBCD;
+                               Const Format : TFormatSettings) : Boolean;
     var
     var
 {$ifndef use_ansistring}
 {$ifndef use_ansistring}
       lav : {$ifopt r+} 0..high ( aValue ) {$else} Integer {$endif};
       lav : {$ifopt r+} 0..high ( aValue ) {$else} Integer {$endif};
@@ -1385,8 +1373,6 @@ IMPLEMENTATION
       i   : {$ifopt r+} longword {$else} longword {$endif};
       i   : {$ifopt r+} longword {$else} longword {$endif};
 {$endif}
 {$endif}
       ch : Char;
       ch : Char;
-      dp,
-      dc : Char;
 
 
     type
     type
       ife = ( inint, infrac, inexp );
       ife = ( inint, infrac, inexp );
@@ -1426,7 +1412,6 @@ IMPLEMENTATION
           WITH lvars,
           WITH lvars,
                bh do
                bh do
             begin
             begin
-              SetDecimals ( dp, dc );
               while ( pfnb < lav ) AND ( NOT nbf ) do
               while ( pfnb < lav ) AND ( NOT nbf ) do
                 begin
                 begin
                   Inc ( pfnb );
                   Inc ( pfnb );
@@ -1465,12 +1450,11 @@ IMPLEMENTATION
                                      end;
                                      end;
                                    end;
                                    end;
                         ',',
                         ',',
-                        '.': if ch = dp
-                               then begin
-                                 if inife <> inint
-                                   then result := False
-                                   else inife := infrac;
-                                end;
+                        '.': if ch = Format.DecimalSeparator then
+                             begin
+                               if inife <> inint then result := False
+                               else inife := infrac;
+                             end;
                         'e',
                         'e',
                         'E': if inife = inexp
                         'E': if inife = inexp
                                then result := False
                                then result := False
@@ -1505,7 +1489,7 @@ IMPLEMENTATION
                       for i := fp[inexp] TO lp[inexp] do
                       for i := fp[inexp] TO lp[inexp] do
                         if result
                         if result
                           then
                           then
-                            if aValue[i] <> dc
+                            if aValue[i] <> Format.ThousandSeparator
                               then begin
                               then begin
                                 exp := exp * 10 + ( Ord ( aValue[i] ) - Ord ( '0' ) );
                                 exp := exp * 10 + ( Ord ( aValue[i] ) - Ord ( '0' ) );
                                 if exp > 999
                                 if exp > 999
@@ -1524,7 +1508,7 @@ IMPLEMENTATION
                   if fp[infrac] <> 0
                   if fp[infrac] <> 0
                     then begin
                     then begin
                       for i := fp[infrac] TO lp[infrac] do
                       for i := fp[infrac] TO lp[infrac] do
-                        if aValue[i] <> dc
+                        if aValue[i] <> Format.ThousandSeparator
                           then begin
                           then begin
                             if p < ( MaxFmtBCDFractionSize + 2 )
                             if p < ( MaxFmtBCDFractionSize + 2 )
                               then begin
                               then begin
@@ -1538,7 +1522,7 @@ IMPLEMENTATION
                   if fp[inint] <> 0
                   if fp[inint] <> 0
                     then
                     then
                       for i := lp[inint] DOWNTO fp[inint] do
                       for i := lp[inint] DOWNTO fp[inint] do
-                        if aValue[i] <> dc
+                        if aValue[i] <> Format.ThousandSeparator
                           then begin
                           then begin
                             if p > - ( MaxFmtBCDFractionSize + 2 )
                             if p > - ( MaxFmtBCDFractionSize + 2 )
                               then begin
                               then begin
@@ -1560,17 +1544,16 @@ IMPLEMENTATION
      end;
      end;
 
 
   function StrToBCD ( const aValue : FmtBCDStringtype ) : tBCD;
   function StrToBCD ( const aValue : FmtBCDStringtype ) : tBCD;
+  begin
+    Result := StrToBCD(aValue, DefaultFormatSettings);
+  end;
 
 
-    var
-      BCD : tBCD;
-
+  function StrToBCD ( const aValue : FmtBCDStringtype;
+                            Const Format : TFormatSettings ) : tBCD;
     begin
     begin
-      if not TryStrToBCD ( aValue, BCD )
-        then begin
-          RAISE eBCDOverflowException.create ( 'in StrToBCD' );
-         end
-        else StrToBCD := BCD;
-     end;
+      if not TryStrToBCD ( aValue, Result, Format ) then
+        raise eBCDOverflowException.create ( 'in StrToBCD' );
+    end;
 
 
 {$ifndef FPUNONE}
 {$ifndef FPUNONE}
   procedure DoubleToBCD ( const aValue : myRealtype;
   procedure DoubleToBCD ( const aValue : myRealtype;
@@ -1578,14 +1561,13 @@ IMPLEMENTATION
 
 
     var
     var
       s : string [ 30 ];
       s : string [ 30 ];
-      dp : tDecimalPoint;
+      f : TFormatSettings;
 
 
     begin
     begin
       Str ( aValue : 25, s );
       Str ( aValue : 25, s );
-      dp := DecimalPoint;
-      DecimalPoint := DecimalPoint_is_Point;
-      BCD := StrToBCD ( s );
-      DecimalPoint := dp;
+      f.DecimalSeparator := '.';
+      f.ThousandSeparator := #0;
+      BCD := StrToBCD ( s, f );
      end;
      end;
 
 
   function DoubleToBCD ( const aValue : myRealtype ) : tBCD; Inline;
   function DoubleToBCD ( const aValue : myRealtype ) : tBCD; Inline;
@@ -1697,13 +1679,17 @@ IMPLEMENTATION
 
 
 { Convert BCD struct to string/Double/Integer }
 { Convert BCD struct to string/Double/Integer }
   function BCDToStr ( const BCD : tBCD ) : FmtBCDStringtype;
   function BCDToStr ( const BCD : tBCD ) : FmtBCDStringtype;
+  begin
+    Result := BCDToStr(BCD, DefaultFormatSettings);
+  end;
 
 
+  function BCDToStr ( const BCD : tBCD;
+                            Const Format : TFormatSettings ) : FmtBCDStringtype;
     var
     var
       bh : tBCD_helper;
       bh : tBCD_helper;
       l :  {$ifopt r+} 0..maxfmtbcdfractionsize + 1 + 1 {$else} Integer {$endif};
       l :  {$ifopt r+} 0..maxfmtbcdfractionsize + 1 + 1 {$else} Integer {$endif};
       i :  {$ifopt r+} low ( bh.FDig )..high ( bh.LDig ) {$else} Integer {$endif};
       i :  {$ifopt r+} low ( bh.FDig )..high ( bh.LDig ) {$else} Integer {$endif};
       pp : {$ifopt r+} low ( bh.FDig ) - 1..1 {$else} Integer {$endif};
       pp : {$ifopt r+} low ( bh.FDig ) - 1..1 {$else} Integer {$endif};
-      dp, dc : Char;
 
 
     begin
     begin
 {$ifdef use_ansistring}
 {$ifdef use_ansistring}
@@ -1712,7 +1698,6 @@ IMPLEMENTATION
       unpack_BCD ( BCD, bh );
       unpack_BCD ( BCD, bh );
       WITH bh do
       WITH bh do
         begin
         begin
-          SetDecimals ( dp, dc );
           l := 0;
           l := 0;
           if Neg
           if Neg
             then begin
             then begin
@@ -1743,9 +1728,9 @@ IMPLEMENTATION
                     then begin
                     then begin
 {$ifndef use_ansistring}
 {$ifndef use_ansistring}
                       Inc ( l );
                       Inc ( l );
-                      result[l] := dp;
+                      result[l] := Format.DecimalSeparator;
 {$else}
 {$else}
-                      result := result + dp;
+                      result := result + Format.DecimalSeparator;
 {$endif}
 {$endif}
                      end;
                      end;
 {$ifndef use_ansistring}
 {$ifndef use_ansistring}
@@ -2535,7 +2520,8 @@ writeln ( '> ', i4, ' ', bh.Singles[i4], ' ', Add );
       Result := BCDToStr(BCD);
       Result := BCDToStr(BCD);
       if Format = ffGeneral then Exit;
       if Format = ffGeneral then Exit;
 
 
-      SetDecimals(DS, TS);
+      DS:=DefaultFormatSettings.DecimalSeparator;
+      TS:=DefaultFormatSettings.ThousandSeparator;
 
 
       Negative := Result[1] = '-';
       Negative := Result[1] = '-';
       P := Pos(DS, Result);
       P := Pos(DS, Result);