fcl-db: sqldb: Firebird

- [var]char columns with character set NONE or OCTETS does not follow connection charset, so we must handle them as special case and set appropriate CodePage
- updated helper method TFieldDefs.Add (original version was introduced only recently and exists only in trunk)
Bug #30613

git-svn-id: trunk@34541 -

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

@@ -212,7 +212,7 @@ type
   public
     constructor Create(ADataSet: TDataSet);
 //    destructor Destroy; override;
-    Function Add(const AName: string; ADataType: TFieldType; ASize: Word; ARequired: Boolean; AFieldNo : Integer; ACodePage:TSystemCodePage) : TFieldDef; overload;
+    Function Add(const AName: string; ADataType: TFieldType; ASize, APrecision: Integer; ARequired, AReadOnly: Boolean; AFieldNo : Integer; ACodePage:TSystemCodePage) : TFieldDef; overload;
     Function Add(const AName: string; ADataType: TFieldType; ASize: Word; ARequired: Boolean; AFieldNo : Integer) : TFieldDef; overload;
     procedure Add(const AName: string; ADataType: TFieldType; ASize: Word; ARequired: Boolean); overload;
     procedure Add(const AName: string; ADataType: TFieldType; ASize: Word); overload;

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

@@ -225,7 +225,7 @@ begin
   // fieldno is 1 based !
   BeginUpdate;
   try
-    Add(AName,ADataType,ASize,Arequired,Count+1);
+    Add(AName,ADataType,ASize,ARequired,Count+1);
   finally
     EndUpdate;
   end;
@@ -252,9 +252,16 @@ begin
   Inherited Create(ADataset, Owner, FieldDefClass);
 end;
 
-function TFieldDefs.Add(const AName: string; ADataType: TFieldType; ASize: Word; ARequired: Boolean; AFieldNo: Integer; ACodePage: TSystemCodePage): TFieldDef;
+function TFieldDefs.Add(const AName: string; ADataType: TFieldType; ASize, APrecision: Integer;
+  ARequired, AReadOnly: Boolean; AFieldNo: Integer; ACodePage: TSystemCodePage): TFieldDef;
 begin
-  Result:=FieldDefClass.Create(Self,AName,ADataType,ASize,ARequired,AFieldNo,ACodePage);
+  Result:=FieldDefClass.Create(Self, MakeNameUnique(AName), ADataType, ASize, ARequired, AFieldNo, ACodePage);
+  case ADataType of
+    ftBCD, ftFmtBCD:
+      Result.Precision := APrecision;
+  end;
+  if AReadOnly then
+    Result.Attributes := Result.Attributes + [faReadOnly];
 end;
 
 function TFieldDefs.Add(const AName: string; ADataType: TFieldType; ASize: Word; ARequired: Boolean; AFieldNo: Integer): TFieldDef;

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

@@ -939,6 +939,9 @@ end;
 
 
 procedure TIBConnection.AddFieldDefs(cursor: TSQLCursor;FieldDefs : TFieldDefs);
+const
+  CS_NONE=0;
+  CS_BINARY=1;
 var
   x         : integer;
   TransLen,
@@ -956,7 +959,11 @@ begin
       TranslateFldType(SQLDA^.SQLVar[x].SQLType, SQLDA^.SQLVar[x].sqlsubtype, SQLDA^.SQLVar[x].SQLLen, SQLDA^.SQLVar[x].SQLScale,
         TransType, TransLen, TransPrec);
 
-      AddFieldDef(FieldDefs, x+1, SQLDA^.SQLVar[x].AliasName, TransType, TransLen, TransPrec, True, (SQLDA^.SQLVar[x].sqltype and 1)=0, False);
+      // column character set NONE or OCTETS overrides connection charset
+      if (TransType in [ftString, ftFixedChar]) and (SQLDA^.SQLVar[x].sqlsubtype and $FF in [CS_NONE,CS_BINARY]) then
+        FieldDefs.Add(SQLDA^.SQLVar[x].AliasName, TransType, TransLen, TransPrec, (SQLDA^.SQLVar[x].sqltype and 1)=0, False, x+1, CP_NONE)
+      else
+        AddFieldDef(FieldDefs, x+1, SQLDA^.SQLVar[x].AliasName, TransType, TransLen, TransPrec, True, (SQLDA^.SQLVar[x].sqltype and 1)=0, False);
 
       FieldBinding[x] := x;
       end;

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

@@ -1428,13 +1428,7 @@ begin
   end
   else
     ACodePage := 0;
-  Result := AFieldDefs.Add(AFieldDefs.MakeNameUnique(AName), ADataType, ASize, ARequired, AFieldNo, ACodePage);
-  if AReadOnly then
-    Result.Attributes := Result.Attributes + [faReadOnly];
-  case ADataType of
-    ftBCD, ftFmtBCD:
-      Result.Precision := APrecision;
-  end;
+  Result := AFieldDefs.Add(AName, ADataType, ASize, APrecision, ARequired, AReadOnly, AFieldNo, ACodePage);
 end;
 
 procedure TSQLConnection.GetTableNames(List: TStrings; SystemTables: Boolean);

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

@@ -454,7 +454,6 @@ begin
     FN:=sqlite3_column_name(st,i);
     FD:=uppercase(sqlite3_column_decltype(st,i));
     ft1:= ftUnknown;
-    size1:= 0;
     for fi := 1 to FieldMapCount do if pos(FieldMap[fi].N,FD)=1 then
       begin
       ft1:=FieldMap[fi].t;
@@ -476,6 +475,7 @@ begin
       end;
     // handle some specials.
     size1:=0;
+    size2:=0;
     case ft1 of
       ftString,
       ftFixedChar,
@@ -500,7 +500,7 @@ begin
                end;
       ftUnknown : DatabaseErrorFmt('Unknown or unsupported data type %s of column %s', [FD, FN]);
     end; // Case
-    FieldDefs.Add(FieldDefs.MakeNameUnique(FN), ft1, size1, false, i+1, CP_UTF8);
+    FieldDefs.Add(FN, ft1, size1, size2, false, false, i+1, CP_UTF8);
     end;
 end;