--- Merging r18854 into '.':

U    packages/fcl-db/src/base/fields.inc
--- Merging r18872 into '.':
U    packages/fcl-db/src/memds/memds.pp
U    packages/fcl-db/src/base/bufdataset.pas
G    packages/fcl-db/src/base/fields.inc
U    packages/fcl-db/src/sdf/sdfdata.pp
U    packages/fcl-db/src/dbase/dbf.pas
--- Merging r18873 into '.':
U    packages/fcl-db/tests/database.ini.txt
--- Merging r18874 into '.':
U    packages/fcl-db/tests/README.txt
--- Merging r18875 into '.':
U    packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp
--- Merging r18949 into '.':
U    packages/fcl-db/src/sqldb/interbase/ibconnection.pp
--- Merging r18951 into '.':
U    packages/fcl-db/src/sqldb/mysql/mysqlconn.inc
--- Merging r18952 into '.':
U    packages/ibase/src/ibase60.inc
--- Merging r18988 into '.':
G    packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp
--- Merging r18989 into '.':
U    packages/fcl-db/src/base/db.pas
G    packages/fcl-db/src/base/fields.inc
--- Merging r18990 into '.':
G    packages/fcl-db/src/sqldb/mysql/mysqlconn.inc
--- Merging r18991 into '.':
G    packages/fcl-db/src/sqldb/mysql/mysqlconn.inc
--- Merging r18992 into '.':
U    packages/fcl-db/src/sqldb/postgres/pqconnection.pp
--- Merging r18993 into '.':
U    packages/fcl-db/src/sqldb/odbc/odbcconn.pas
--- Merging r18994 into '.':
G    packages/fcl-db/src/sqldb/mysql/mysqlconn.inc

# revisions: 18854,18872,18873,18874,18875,18949,18951,18952,18988,18989,18990,18991,18992,18993,18994
------------------------------------------------------------------------
r18854 | marco | 2011-08-26 15:44:05 +0200 (Fri, 26 Aug 2011) | 3 lines
Changed paths:
   M /trunk/packages/fcl-db/src/base/fields.inc

 * Fix for Mantis #20041, check assignment of buffer in TField.Getdata
    (IsNull might call it with a dummy buffer)

------------------------------------------------------------------------
------------------------------------------------------------------------
r18872 | marco | 2011-08-28 10:06:20 +0200 (Sun, 28 Aug 2011) | 3 lines
Changed paths:
   M /trunk/packages/fcl-db/src/base/bufdataset.pas
   M /trunk/packages/fcl-db/src/base/fields.inc
   M /trunk/packages/fcl-db/src/dbase/dbf.pas
   M /trunk/packages/fcl-db/src/memds/memds.pp
   M /trunk/packages/fcl-db/src/sdf/sdfdata.pp

 * move validate to newvalue assignment, fixes regression in non fcl-db datasets
    caused by r17220. Patch by Luiz Americo, Mantis #19313

------------------------------------------------------------------------
------------------------------------------------------------------------
r18873 | marco | 2011-08-28 16:40:50 +0200 (Sun, 28 Aug 2011) | 4 lines
Changed paths:
   M /trunk/packages/fcl-db/tests/database.ini.txt

 * committed patch that improves comments and changes interbase/firebird pwd to the default "masterkey"
   Patch from BigChimp, Mantis #20078
   

------------------------------------------------------------------------
------------------------------------------------------------------------
r18874 | marco | 2011-08-28 16:43:00 +0200 (Sun, 28 Aug 2011) | 2 lines
Changed paths:
   M /trunk/packages/fcl-db/tests/README.txt

 * small rewording and enhancement of readme.txt, Patch by Bigchimp, Mantis #20079

------------------------------------------------------------------------
------------------------------------------------------------------------
r18875 | marco | 2011-08-28 16:56:46 +0200 (Sun, 28 Aug 2011) | 2 lines
Changed paths:
   M /trunk/packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp

 * patch to order output of getschemainfo(sttables) for sqlite, patch by Lacak2, mantis #19957

------------------------------------------------------------------------
------------------------------------------------------------------------
r18949 | marco | 2011-09-02 21:05:24 +0200 (Fri, 02 Sep 2011) | 2 lines
Changed paths:
   M /trunk/packages/fcl-db/src/sqldb/interbase/ibconnection.pp

 * Check against operation on unopend statement, patch from Lacak2 Mantis #19943

------------------------------------------------------------------------
------------------------------------------------------------------------
r18951 | marco | 2011-09-02 21:54:10 +0200 (Fri, 02 Sep 2011) | 2 lines
Changed paths:
   M /trunk/packages/fcl-db/src/sqldb/mysql/mysqlconn.inc

 * Patch from Lacak2, Map mysql textual blob to ftmemo on mysql5+. Mantis #19911

------------------------------------------------------------------------
------------------------------------------------------------------------
r18952 | marco | 2011-09-02 22:25:48 +0200 (Fri, 02 Sep 2011) | 2 lines
Changed paths:
   M /trunk/packages/ibase/src/ibase60.inc

 * also test for fbembed in old "auto" initialization. Mantis #17664

------------------------------------------------------------------------
------------------------------------------------------------------------
r18988 | marco | 2011-09-06 13:50:10 +0200 (Tue, 06 Sep 2011) | 2 lines
Changed paths:
   M /trunk/packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp

 * sqlite bcd fixes. Mantis #16924, patch by Lacak2

------------------------------------------------------------------------
------------------------------------------------------------------------
r18989 | marco | 2011-09-06 14:06:49 +0200 (Tue, 06 Sep 2011) | 2 lines
Changed paths:
   M /trunk/packages/fcl-db/src/base/db.pas
   M /trunk/packages/fcl-db/src/base/fields.inc

 * aslargeint for TLongintfield, mantis #18287, patch by Lacak2

------------------------------------------------------------------------
------------------------------------------------------------------------
r18990 | marco | 2011-09-06 14:09:38 +0200 (Tue, 06 Sep 2011) | 2 lines
Changed paths:
   M /trunk/packages/fcl-db/src/sqldb/mysql/mysqlconn.inc

 * add ftfixedchar to escape clause of getsqltext, Mantis #19556 Patch by Lacak2.

------------------------------------------------------------------------
------------------------------------------------------------------------
r18991 | marco | 2011-09-06 14:16:42 +0200 (Tue, 06 Sep 2011) | 2 lines
Changed paths:
   M /trunk/packages/fcl-db/src/sqldb/mysql/mysqlconn.inc

 * update decimal support with newer ftfmtbcd support. Mantis #19664 patch by Lacak2.

------------------------------------------------------------------------
------------------------------------------------------------------------
r18992 | marco | 2011-09-06 14:23:17 +0200 (Tue, 06 Sep 2011) | 2 lines
Changed paths:
   M /trunk/packages/fcl-db/src/sqldb/postgres/pqconnection.pp

 * ftfmtbcd for postgresm Mantis 19681, patch by Lacak2

------------------------------------------------------------------------
------------------------------------------------------------------------
r18993 | marco | 2011-09-06 14:25:38 +0200 (Tue, 06 Sep 2011) | 2 lines
Changed paths:
   M /trunk/packages/fcl-db/src/sqldb/odbc/odbcconn.pas

 * odbc ftguid fixes, correct size (38) in setparameters. Mantis #19774, patch by lacak2

------------------------------------------------------------------------
------------------------------------------------------------------------
r18994 | marco | 2011-09-06 14:51:38 +0200 (Tue, 06 Sep 2011) | 2 lines
Changed paths:
   M /trunk/packages/fcl-db/src/sqldb/mysql/mysqlconn.inc

 * fixed minor issue with r18991.

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

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

packages/fcl-db/src/base/bufdataset.pas

@@ -1864,14 +1864,15 @@ var CurrBuff : pointer;
     NullMask : pbyte;
 
 begin
-  if not (state in [dsEdit, dsInsert, dsFilter, dsCalcFields]) then
-    begin
-    DatabaseErrorFmt(SNotEditing,[Name],self);
-    exit;
-    end;
+  if not (State in dsWriteModes) then
+    DatabaseError(SNotEditing, Self);
   CurrBuff := GetCurrentBuffer;
   If Field.Fieldno > 0 then // If = 0, then calculated field or something
     begin
+    if Field.ReadOnly and not (State in [dsSetKey, dsFilter]) then
+      DatabaseErrorFmt(SReadOnlyField, [Field.DisplayName]);	
+    if State in [dsEdit, dsInsert, dsNewValue] then
+      Field.Validate(Buffer);	
     NullMask := CurrBuff;
 
     inc(CurrBuff,FFieldBufPositions[Field.FieldNo-1]);

packages/fcl-db/src/base/db.pas

@@ -546,6 +546,8 @@ type
     procedure SetAsLongint(AValue: Longint); override;
     procedure SetAsString(const AValue: string); override;
     procedure SetVarValue(const AValue: Variant); override;
+    function GetAsLargeint: Largeint; override;
+    procedure SetAsLargeint(AValue: Largeint); override;
   public
     constructor Create(AOwner: TComponent); override;
     Function CheckRange(AValue : longint) : Boolean;

packages/fcl-db/src/base/fields.inc

@@ -558,8 +558,8 @@ begin
     DatabaseErrorFmt(SNoDataset,[FieldName]);
   If FVAlidating then
     begin
-    result:=Not(FValueBuffer=Nil);
-    If Result then
+    result:=assigned(FValueBuffer);
+    If Result and assigned(Buffer) then
       Move (FValueBuffer^,Buffer^ ,DataSize);
     end
   else
@@ -820,12 +820,6 @@ procedure TField.SetData(Buffer: Pointer; NativeFormat : Boolean);
 begin
   If Not Assigned(FDataset) then
     DatabaseErrorFmt(SNoDataset,[FieldName]);
-  if (FieldNo>0) and not (FDataSet.State in [dsSetKey, dsFilter]) then
-    begin
-    if ReadOnly then 
-      DatabaseErrorFmt(SReadOnlyField, [DisplayName], Self); 
-    Validate(Buffer);
-    end;
   FDataSet.SetFieldData(Self,Buffer, NativeFormat);
 end;
 
@@ -1369,6 +1363,11 @@ begin
   Result:=GetAsLongint;
 end;
 
+function TLongintField.GetAsLargeint: Largeint;
+begin
+  Result:=GetAsLongint;
+end;
+
 function TLongintField.GetAsLongint: Longint;
 
 begin
@@ -1438,6 +1437,14 @@ begin
     end;
 end;
 
+procedure TLongintField.SetAsLargeint(AValue: Largeint);
+begin
+  if (AValue>=FMinRange) and (AValue<=FMaxRange) then
+    SetAsLongint(AValue)
+  else
+    RangeError(AValue,FMinRange,FMaxRange);
+end;
+
 procedure TLongintField.SetAsFloat(AValue: Double);
 
 begin

packages/fcl-db/src/dbase/dbf.pas

@@ -764,6 +764,8 @@ var
 begin
   if (Field.FieldNo >= 0) then
   begin
+    if State in [dsEdit, dsInsert, dsNewValue] then
+      Field.Validate(Buffer);
     Dst := @PDbfRecord(ActiveBuffer)^.DeletedFlag;
     FDbfFile.SetFieldData(Field.FieldNo - 1, Field.DataType, Buffer, Dst, NativeFormat);
   end else begin    { ***** fkCalculated, fkLookup ***** }

packages/fcl-db/src/memds/memds.pp

@@ -728,6 +728,8 @@ begin
  I:= Field.FieldNo - 1;
  if (I >= 0) and  MDSGetActiveBuffer(DestBuffer) then 
    begin
+   if State in [dsEdit, dsInsert, dsNewValue] then
+      Field.Validate(Buffer);
    if buffer = nil then 
      setfieldisnull(pointer(destbuffer),I)
    else 

packages/fcl-db/src/sdf/sdfdata.pp

@@ -128,7 +128,7 @@ How to Install
 interface
 
 uses
-  DB, Classes, SysUtils;
+  DB, Classes, SysUtils, DBConst;
 
 type
 //-----------------------------------------------------------------------------
@@ -664,16 +664,17 @@ var
   RecBuf, BufEnd: PChar;
   p : Integer;
 begin
-  if not (State in [dsEdit, dsInsert]) then
-    DatabaseError('Dataset not in edit or insert mode', Self);
+  if not (State in dsWriteModes) then
+    DatabaseError(SNotEditing, Self);
   GetActiveRecBuf(RecBuf);
   if Field.FieldNo > 0 then
   begin
     if State = dsCalcFields then
       DatabaseError('Dataset not in edit or insert mode', Self);
     if Field.ReadOnly and not (State in [dsSetKey, dsFilter]) then
-      DatabaseErrorFmt('Field ''%s'' cannot be modified', [Field.DisplayName]);
-    Field.Validate(Buffer);
+      DatabaseErrorFmt(SReadOnlyField, [Field.DisplayName]);
+    if State in [dsEdit, dsInsert, dsNewValue] then
+      Field.Validate(Buffer);
     if Field.FieldKind <> fkInternalCalc then
     begin
       SetFieldPos(RecBuf, Field.FieldNo);

packages/fcl-db/src/sqldb/interbase/ibconnection.pp

@@ -615,12 +615,13 @@ procedure TIBConnection.UnPrepareStatement(cursor : TSQLCursor);
 
 begin
   with cursor as TIBcursor do
-    begin
-    if isc_dsql_free_statement(@Status[0], @Statement, DSQL_Drop) <> 0 then
-      CheckError('FreeStatement', Status);
-    Statement := nil;
-    FPrepared := False;
-    end;
+    if assigned(Statement) Then
+      begin
+        if isc_dsql_free_statement(@Status[0], @Statement, DSQL_Drop) <> 0 then
+          CheckError('FreeStatement', Status);
+        Statement := nil;
+        FPrepared := False;
+      end;
 end;
 
 procedure TIBConnection.FreeSQLDABuffer(var aSQLDA : PXSQLDA);

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

@@ -78,7 +78,7 @@ Type
     function StrToStatementType(s : string) : TStatementType; override;
     Procedure ConnectToServer; virtual;
     Procedure SelectDatabase; virtual;
-    function MySQLDataType(AType: enum_field_types; ASize, ADecimals: Integer; var NewType: TFieldType; var NewSize: Integer): Boolean;
+    function MySQLDataType(AField: PMYSQL_FIELD; var NewType: TFieldType; var NewSize: Integer): Boolean;
     function MySQLWriteData(AType: enum_field_types;ASize: Integer; AFieldType: TFieldType; Source, Dest: PChar; out CreateBlob : boolean): Boolean;
     // SQLConnection methods
     procedure DoInternalConnect; override;
@@ -179,7 +179,8 @@ uses
   dbconst,
   ctypes,
   strutils,
-  dateutils;
+  dateutils,
+  FmtBCD;
 
 const
   Mysql_Option_Names : array[mysql_option] of string = ('MYSQL_OPT_CONNECT_TIMEOUT','MYSQL_OPT_COMPRESS',
@@ -328,7 +329,7 @@ var esc_str : pchar;
 
 begin
   if (not assigned(param)) or param.IsNull then Result := 'Null'
-  else if param.DataType in [ftString,ftBlob,ftMemo] then
+  else if param.DataType in [ftString,ftFixedChar,ftBlob,ftMemo] then
     Result := '''' + EscapeString(Param.AsString) + ''''
   else Result := inherited GetAsSqlText(Param);
 end;
@@ -539,11 +540,12 @@ begin
     end;
 end;
 
-function TConnectionName.MySQLDataType(AType: enum_field_types; ASize, ADecimals: Integer;
-   var NewType: TFieldType; var NewSize: Integer): Boolean;
+function TConnectionName.MySQLDataType(AField: PMYSQL_FIELD; var NewType: TFieldType; var NewSize: Integer): Boolean;
+var ASize, ADecimals: integer;
 begin
   Result := True;
-  case AType of
+  ASize := AField^.length;
+  case AField^.ftype of
     FIELD_TYPE_LONGLONG:
       begin
       NewType := ftLargeint;
@@ -562,16 +564,20 @@ begin
 {$ifdef mysql50_up}
     FIELD_TYPE_NEWDECIMAL,
 {$endif}
-    FIELD_TYPE_DECIMAL: if ADecimals < 5 then
-                          begin
-                          NewType := ftBCD;
-                          NewSize := ADecimals;
-                          end
-                        else
-                          begin
-                          NewType := ftFloat;
-                          NewSize := 0;
-                          end;
+    FIELD_TYPE_DECIMAL: 
+      begin
+        ADecimals:=AField^.decimals;
+        if (ADecimals < 5) and (ASize-2-ADecimals < 15) then //ASize is display size i.e. with sign and decimal point
+          NewType := ftBCD
+        else 
+          begin
+            if (ADecimals = 0) and (ASize < 20) then
+              NewType := ftLargeInt
+            else
+              NewType := ftFmtBCD;
+          end;
+        NewSize := ADecimals;
+      end;
     FIELD_TYPE_FLOAT, FIELD_TYPE_DOUBLE:
       begin
       NewType := ftFloat;
@@ -609,7 +615,14 @@ begin
       end;
     FIELD_TYPE_BLOB:
       begin
+{$IFDEF MYSQL50_UP}
+      if AField^.charsetnr = 63 then //character set is binary
+        NewType := ftBlob
+      else
+        NewType := ftMemo;
+{$ELSE}
       NewType := ftBlob;
+{$ENDIF}
       NewSize := 0;
       end
   else
@@ -645,7 +658,7 @@ begin
     field := mysql_fetch_field_direct(C.FRES, I);
 //    Writeln('MySQL: creating fielddef ',I+1);
 
-    if MySQLDataType(field^.ftype, field^.length, field^.decimals, DFT, DFS) then
+    if MySQLDataType(field, DFT, DFS) then
       begin
       TFieldDef.Create(FieldDefs, FieldDefs.MakeNameUnique(field^.name), DFT, DFS, False, TF);
       c.MapDSRowToMSQLRow[TF-1] := I;
@@ -834,6 +847,7 @@ var
   VF: Double;
   VC: Currency;
   VD: TDateTime;
+  VB: TBCD;
   Src : String;
 
 begin
@@ -876,6 +890,11 @@ begin
         VC := InternalStrToCurrency(Src);
         Move(VC, Dest^, SizeOf(Currency));
         end
+      else if AFieldType = ftFmtBCD then
+        begin
+        VB:=StrToBCD(Src, FSQLFormatSettings);
+        Move(VB, Dest^, SizeOf(TBCD));
+        end
       else
         begin
         if Src <> '' then

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

@@ -353,7 +353,7 @@ begin
           SqlType:=SQL_BIGINT;
           ColumnSize:=19;
         end;
-      ftString, ftFixedChar, ftBlob, ftMemo:
+      ftString, ftFixedChar, ftBlob, ftMemo, ftGuid:
         begin
           StrVal:=AParams[ParamIndex].AsString;
           StrLenOrInd:=Length(StrVal);
@@ -1097,7 +1097,7 @@ begin
 {      SQL_INTERVAL_HOUR_TO_SECOND:  FieldType:=ftUnknown;}
 {      SQL_INTERVAL_MINUTE_TO_SECOND:FieldType:=ftUnknown;}
 {$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}
-      SQL_GUID:          begin FieldType:=ftGuid;       FieldSize:=ColumnSize; end;
+      SQL_GUID:          begin FieldType:=ftGuid;       FieldSize:=38; end; //SQL_GUID defines 36, but TGuidField requires 38
 {$ENDIF}
     else
       begin FieldType:=ftUnknown; FieldSize:=ColumnSize; end

packages/fcl-db/src/sqldb/postgres/pqconnection.pp

@@ -39,7 +39,7 @@ type
     FConnectString       : string;
     FSQLDatabaseHandle   : pointer;
     FIntegerDateTimes    : boolean;
-    function TranslateFldType(res : PPGresult; Tuple : integer; var Size : integer) : TFieldType;
+    function TranslateFldType(res : PPGresult; Tuple : integer; out Size : integer) : TFieldType;
     procedure ExecuteDirectPG(const Query : String);
   protected
     procedure DoInternalConnect; override;
@@ -89,7 +89,7 @@ type
 
 implementation
 
-uses math, strutils;
+uses math, strutils, FmtBCD;
 
 ResourceString
   SErrRollbackFailed = 'Rollback transaction failed';
@@ -382,7 +382,8 @@ begin
 
 end;
 
-function TPQConnection.TranslateFldType(res : PPGresult; Tuple : integer; var Size : integer) : TFieldType;
+function TPQConnection.TranslateFldType(res : PPGresult; Tuple : integer; out Size : integer) : TFieldType;
+const VARHDRSZ=sizeof(longint);
 var li : longint;
 begin
   Size := 0;
@@ -397,7 +398,7 @@ begin
                                if li = -1 then
                                  size := dsMaxStringSize
                                else
-                                 size := (li-4) and $FFFF;
+                                 size := (li-VARHDRSZ) and $FFFF;
                                end;
                              if size > dsMaxStringSize then size := dsMaxStringSize;
                              end;
@@ -421,11 +422,11 @@ begin
                                size := 4 // No information about the size available, use the maximum value
                              else
                              // The precision is the high 16 bits, the scale the
-                             // low 16 bits. Both with an offset of 4.
-                             // In this case we need the scale:
+                             // low 16 bits with an offset of sizeof(int32).
                                begin
-                               size := (li-4) and $FFFF;
-                               if size > 4 then size:=4; //ftBCD allows max.scale 4, when ftFmtBCD will be implemented then use it
+                               size := (li-VARHDRSZ) and $FFFF;
+                               if (size > MaxBCDScale) or ((li shr 16)-size > MaxBCDPrecision-MaxBCDScale) then
+                                 Result := ftFmtBCD;
                                end;
                              end;
     Oid_Money              : Result := ftCurrency;
@@ -613,7 +614,9 @@ begin
                 cash:=NtoBE(round(AParams[i].AsCurrency*100));
                 setlength(s, sizeof(cash));
                 Move(cash, s[1], sizeof(cash));
-              end
+              end;
+            ftFmtBCD:
+              s := BCDToStr(AParams[i].AsFMTBCD, FSQLFormatSettings);
             else
               s := AParams[i].AsString;
           end; {case}
@@ -712,6 +715,8 @@ end;
 
 function TPQConnection.LoadField(cursor : TSQLCursor;FieldDef : TfieldDef;buffer : pointer; out CreateBlob : boolean) : boolean;
 
+const NBASE=10000;
+
 type TNumericRecord = record
        Digits : SmallInt;
        Weight : SmallInt;
@@ -720,15 +725,15 @@ type TNumericRecord = record
      end;
 
 var
-  x,i           : integer;
+  x,i,j         : integer;
   s             : string;
   li            : Longint;
   CurrBuff      : pchar;
-  tel           : byte;
   dbl           : pdouble;
   cur           : currency;
   NumericRecord : ^TNumericRecord;
   guid          : TGUID;
+  bcd           : TBCD;
 
 begin
   Createblob := False;
@@ -760,8 +765,8 @@ begin
             sizeof(integer) : pinteger(buffer)^ := BEtoN(pinteger(CurrBuff)^);
             sizeof(smallint) : psmallint(buffer)^ := BEtoN(psmallint(CurrBuff)^);
           else
-            for tel := 1 to i do
-              pchar(Buffer)[tel-1] := CurrBuff[i-tel];
+            for j := 1 to i do
+              pchar(Buffer)[j-1] := CurrBuff[i-j];
           end; {case}
           end;
         ftString, ftFixedChar :
@@ -791,25 +796,37 @@ begin
           if (dbl^ <= 0) and (frac(dbl^)<0) then
             dbl^ := trunc(dbl^)-2-frac(dbl^);
           end;
-        ftBCD:
+        ftBCD, ftFmtBCD:
           begin
           NumericRecord := pointer(CurrBuff);
           NumericRecord^.Digits := BEtoN(NumericRecord^.Digits);
-          NumericRecord^.Scale := BEtoN(NumericRecord^.Scale);
           NumericRecord^.Weight := BEtoN(NumericRecord^.Weight);
+          NumericRecord^.Sign := BEtoN(NumericRecord^.Sign);
+          NumericRecord^.Scale := BEtoN(NumericRecord^.Scale);
           inc(pointer(currbuff),sizeof(TNumericRecord));
-          cur := 0;
           if (NumericRecord^.Digits = 0) and (NumericRecord^.Scale = 0) then // = NaN, which is not supported by Currency-type, so we return NULL
             result := false
-          else
+          else if FieldDef.DataType = ftBCD then
             begin
-            for tel := 1 to NumericRecord^.Digits  do
+            cur := 0;
+            for i := 0 to NumericRecord^.Digits-1 do
               begin
-              cur := cur + beton(pword(currbuff)^) * intpower(10000,-(tel-1)+NumericRecord^.weight);
-              inc(pointer(currbuff),2);
+              cur := cur + beton(pword(CurrBuff)^) * intpower(NBASE, NumericRecord^.weight-i);
+              inc(pointer(CurrBuff),2);
               end;
-            if BEtoN(NumericRecord^.Sign) <> 0 then cur := -cur;
+            if NumericRecord^.Sign <> 0 then cur := -cur;
             Move(Cur, Buffer^, sizeof(currency));
+            end
+          else //ftFmtBCD
+            begin
+            bcd := 0;
+            for i := 0 to NumericRecord^.Digits-1 do
+              begin
+              BCDAdd(bcd, beton(pword(CurrBuff)^) * intpower(NBASE, NumericRecord^.weight-i), bcd);
+              inc(pointer(CurrBuff),2);
+              end;
+            if NumericRecord^.Sign <> 0 then BCDNegate(bcd);
+            Move(bcd, Buffer^, sizeof(bcd));
             end;
           end;
         ftCurrency  :

packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp

@@ -99,7 +99,7 @@ Var
 implementation
 
 uses
-  dbconst, sysutils, dateutils,FmtBCD;
+  dbconst, sysutils, dateutils, FmtBCD;
 
 const
   JulianDateShift = 2415018.5; //distance from "julian day 0" (January 1, 4713 BC 12:00AM) to "1899-12-30 00:00AM"
@@ -111,6 +111,7 @@ type
  TSQLite3Cursor = class(tsqlcursor)
   private
    fhandle : psqlite3;
+   fconnection: TSQLite3Connection;
    fstatement: psqlite3_stmt;
    ftail: pchar;
    fstate: integer;
@@ -189,7 +190,11 @@ begin
                 do1:= P.AsFloat + JulianDateShift;
                 checkerror(sqlite3_bind_double(fstatement,I,do1));
                 end;
-        ftFMTBcd,
+        ftFMTBcd:
+                begin
+                str1:=BCDToStr(P.AsFMTBCD, Fconnection.FSQLFormatSettings);
+                checkerror(sqlite3_bind_text(fstatement, I, PChar(str1), length(str1), sqlite3_destructor_type(SQLITE_TRANSIENT)));
+                end;
         ftstring,
         ftFixedChar,
         ftmemo: begin // According to SQLite documentation, CLOB's (ftMemo) have the Text affinity
@@ -315,6 +320,7 @@ Var
 
 begin
   Res:= TSQLite3Cursor.create;
+  Res.fconnection:=Self;
   Result:=Res;
 end;
 
@@ -382,11 +388,35 @@ var
  i     : integer;
  FN,FD : string;
  ft1   : tfieldtype;
- size1 : word;
+ size1, size2 : integer;
  ar1   : TStringArray;
  fi    : integer;
  st    : psqlite3_stmt;
- 
+
+ function ExtractPrecisionAndScale(decltype: string; var precision, scale: integer): boolean;
+ var p: integer;
+ begin
+   p:=pos('(', decltype);
+   Result:=p>0;
+   if not Result then Exit;
+   System.Delete(decltype,1,p);
+   p:=pos(')', decltype);
+   Result:=p>0;
+   if not Result then Exit;
+   decltype:=copy(decltype,1,p-1);
+   p:=pos(',', decltype);
+   if p=0 then
+   begin
+     precision:=StrToIntDef(decltype, precision);
+     scale:=0;
+   end
+   else
+   begin
+     precision:=StrToIntDef(copy(decltype,1,p-1), precision);
+     scale:=StrToIntDef(copy(decltype,p+1,length(decltype)-p), scale);
+   end;
+ end;
+
 begin
   st:=TSQLite3Cursor(cursor).fstatement;
   for i:= 0 to sqlite3_column_count(st) - 1 do 
@@ -417,29 +447,21 @@ begin
       ftFixedChar,
       ftFixedWideChar,
       ftWideString:
-                begin
-                fi:=pos('(',FD);
-                if (fi>0) then
-                  begin
-                  System.Delete(FD,1,fi);
-                  fi:=pos(')',FD);
-                  size1:=StrToIntDef(trim(copy(FD,1,fi-1)),255);
-                  if size1 > dsMaxStringSize then size1 := dsMaxStringSize;
-                  end
-                else size1 := 255;
-                end;
-      ftBCD:    begin
-                fi:=pos(',',FD);
-                if (fi>0) then
-                  begin
-                  System.Delete(FD,1,fi);
-                  fi:=pos(')',FD);
-                  size1:=StrToIntDef(trim(copy(FD,1,fi-1)), 0);
-                  if size1>4 then
-                    ft1 := ftFMTBcd;
-                  end
-                else size1 := 0;
-                end;
+               begin
+                 size1 := 255; //sql: if length is omitted then length is 1
+                 size2 := 0;
+                 ExtractPrecisionAndScale(FD, size1, size2);
+                 if size1 > dsMaxStringSize then size1 := dsMaxStringSize;
+               end;
+      ftBCD:   begin
+                 size2 := MaxBCDPrecision; //sql: if a precision is omitted, then use implementation-defined
+                 size1 := 0;               //sql: if a scale is omitted then scale is 0
+                 ExtractPrecisionAndScale(FD, size2, size1);
+                 if (size2<=18) and (size1=0) then
+                   ft1:=ftLargeInt
+                 else if (size2-size1>MaxBCDPrecision-MaxBCDScale) or (size1>MaxBCDScale) then
+                   ft1:=ftFmtBCD;
+               end;
       ftUnknown : DatabaseError('Unknown record type: '+FN);
     end; // Case
     tfielddef.create(fielddefs,FieldDefs.MakeNameUnique(FN),ft1,size1,false,i+1);
@@ -528,6 +550,7 @@ begin
     end;
   Result:=ComposeDateTime(ParseSQLiteDate(DS),ParseSQLiteTime(TS,False));
 end;
+
 function TSQLite3Connection.LoadField(cursor : TSQLCursor;FieldDef : TfieldDef;buffer : pointer; out CreateBlob : boolean) : boolean;
 
 var
@@ -770,7 +793,7 @@ function TSQLite3Connection.GetSchemaInfoSQL(SchemaType: TSchemaType;
   
 begin
   case SchemaType of
-    stTables     : result := 'select name as table_name from sqlite_master where type = ''table''';
+    stTables     : result := 'select name as table_name from sqlite_master where type = ''table'' order by 1';
     stColumns    : result := 'pragma table_info(''' + (SchemaObjectName) + ''')';
   else
     DatabaseError(SMetadataUnavailable)

packages/fcl-db/tests/README.txt

@@ -10,8 +10,9 @@ An simple test-runner (dbtestframework.pas) which generates XML-output is
 included in this directory.
 
 To test a TDataset descendent, a 'connector' is needed to test the database.
-To add a new connector, add it to the uses-section in 'toolsunit.pas'. Several
-connectors are available in the '*toolsunit.pas' files.
+To add a new connector, create a new *toolsunit.pas file, then add it to 
+the uses section in 'dbtestframework.pas'. Several connectors are available 
+in the '*toolsunit.pas' files.
 
 Which connector is currently used is dependent on the 'database.ini'
 configuration file. Also some settings which are connector-dependent can be set

packages/fcl-db/tests/database.ini.txt

@@ -1,9 +1,14 @@
-; This file contains several sections, one for each database-type. Select here
-; which section has to be used currently.
+; This file contains several sections, one for each database type. 
+
+; Select here which section has to be used currently, 
+; i.e. which database you want to use
 [Database]
 type=interbase
 
+
 ; These sections are for the several SQLDB-types of databases:
+
+; PostgreSQL database:
 [postgresql]
 
 ; The connector specifies the DB-component that has to be used. The 'sql'
@@ -28,6 +33,7 @@ password=
 ; hostname of the database-server
 hostname=127.0.0.1
 
+; MySQL 4.0 database:
 [mysql40]
 connector=sql
 connectorparams=mysql40
@@ -36,6 +42,7 @@ user=root
 password=
 hostname=127.0.0.1
 
+; MySQL 4.1 database:
 [mysql41]
 connector=sql
 connectorparams=mysql41
@@ -44,6 +51,7 @@ user=root
 password=
 hostname=127.0.0.1
 
+; MySQL 5.0 database:
 [mysql50]
 connector=sql
 connectorparams=mysql50
@@ -52,6 +60,7 @@ user=root
 password=
 hostname=127.0.0.1
 
+; Oracle database:
 [oracle]
 connector=sql
 connectorparams=oracle
@@ -60,14 +69,18 @@ user=system
 password=
 hostname=127.0.0.1
 
+; Interbase or Firebird database:
 [interbase]
 connector=sql
 connectorparams=interbase
 name=/opt/firebird/data/testdb.fdb
+; Default username/password for Interbase/Firebird
+; is sysdba/masterkey. Change to your situation.
 user=sysdba
-password=
+password=masterkey
 hostname=localhost
 
+; ODBC database:
 [odbc]
 connector=sql
 connectorparams=odbc
@@ -76,19 +89,19 @@ user=root
 password=
 hostname=127.0.0.1
 
+; SQLite database:
 [sqlite]
 connector=sql
 connectorparams=sqlite3
 name=test.db
 
-; This section is for a connector for TDbf:
+; TDBf: DBase/FoxPro database:
 [dbf]
 connector=dbf
 
 ; Give here the path where the *.dbf file can be generated
 name=/tmp
 
-; This section is for a connector for MemDS:
+; MemDS in memory dataset:
 [memds]
 connector=memds
-

packages/ibase/src/ibase60.inc

@@ -2647,9 +2647,10 @@ begin
     end
   else
     begin
-    If (TryInitialiseIBase60(fbclib)=0) and
+    If (TryInitialiseIBase60(fbembedlib)=0) and 
+       (TryInitialiseIBase60(fbclib)=0) and
        (TryInitialiseIBase60(gdslib)=0) then
-        Raise EInOutError.CreateFmt(SErrDefaultsFailed,[gdslib,fbclib]);
+        Raise EInOutError.CreateFmt(SErrDefaultsFailed,[fbembedlib,gdslib,fbclib]);
     end;    
   Result := RefCount;
 end;