* Improved import of data dictionary for Interbase connections

git-svn-id: trunk@11574 -

packages/fcl-db/src/datadict/fpdddiff.pp

@@ -154,8 +154,6 @@ procedure TCustomDDDiffer.CompareField(Source, Target: TDDFieldDefs;
 
   begin
     Result:=(F1.FieldType=F2.FieldType);
-    If (Not Result) and (F1.FieldType in [ftFixedChar,ftString]) then
-      Result:=(F2.FieldType in [ftFixedChar,ftString]);
   end;
 
 var

packages/fcl-db/src/datadict/fpddsqldb.pp

@@ -115,15 +115,144 @@ end;
 function TSQLDBDDEngine.GetTableList(List: TStrings): Integer;
 begin
   FConn.GetTableNames(List,False);
+  result := list.count;
 end;
 
 function TSQLDBDDEngine.ImportFields(Table: TDDTableDef): Integer;
 
 Const
-  SQL = 'SELECT * from %s where (1=0)';
+  SQL = 'SELECT ' +
+        ' F.RDB$FIELD_POSITION as FieldPosition,' +
+        ' F.RDB$FIELD_NAME as Name,' +
+        ' F.RDB$NULL_FLAG as FieldNull,' +
+        ' F.RDB$Description as Description,' +
+        ' F.RDB$DEFAULT_SOURCE as FieldDefault,' +
+        ' D.RDB$DEFAULT_SOURCE as DomainDefault,' +
+        ' D.RDB$FIELD_LENGTH as CharLength,' +
+        ' D.RDB$FIELD_PRECISION as FieldPrecision,' +
+        ' D.RDB$FIELD_SCALE as Scale,' +
+        ' D.RDB$FIELD_TYPE as FieldType,' +
+        ' D.RDB$FIELD_SUB_TYPE as Subtype,' +
+        ' D.RDB$NULL_FLAG as DomainNull ' +
+        ' FROM '+
+        ' RDB$RELATION_FIELDS F left join RDB$FIELDS D on F.RDB$FIELD_Source = D.RDB$FIELD_NAME'+
+        ' WHERE (RDB$RELATION_NAME = ''%s'')' +
+        ' ORDER BY RDB$FIELD_POSITION';
 
 Var
   Q : TSQLQuery;
+  FName, FPosition, FFieldnull, FDescription, FFieldDefault, FDomainDefault,
+  FCharLength, FPrecision, FScale, FFieldType, FSubType, FDomainnull : TField;
+
+  procedure BindFields;
+  begin
+    FName := q.fieldbyname('Name');
+    FPosition := q.fieldbyname('FieldPosition');
+    FFieldnull := q.fieldbyname('FieldNull');
+    FDescription := q.fieldbyname('Description');
+    FFieldDefault := q.fieldbyname('FieldDefault');
+    FDomainDefault := q.fieldbyname('DomainDefault');
+    FCharLength := q.fieldbyname('CharLength');
+    FPrecision := q.fieldbyname('FieldPrecision');
+    FScale := q.fieldbyname('Scale');
+    FFieldType := q.fieldbyname('FieldType');
+    FSubType := q.fieldbyname('SubType');
+    FDomainnull := q.fieldbyname('Domainnull');
+  end;
+
+  function ConvertFBFieldType (FDfieldtype, FBsubtype : integer) : TFieldType;
+  var t : integer;
+      b : byte;
+  begin
+    t := FFieldType.asinteger;
+    if t > 255 then
+      begin
+      if t = 261 then
+        result := ftBlob       {BLOB}
+      else
+        result := ftUnknown;
+      end
+    else
+      begin
+      b := byte(t and $FF);
+      if (b in [7,8,16]) and (FBsubtype <> 0) then
+        // BCD types: 1= Numeric, 2 := Decimal
+        result := ftBCD
+      else
+        case b of
+          14 : result := ftFixedChar; {CHAR}
+          37 : result := ftString;    {VARCHAR}
+          40 : result := ftString;    {CSTRING ?}
+          11 : result := ftFloat;     {D-FLOAT ?}
+          27 : result := ftFloat;     {DOUBLE}
+          10 : result := ftFloat;     {FLOAT}
+          16 : result := ftLargeint;  {INT64}
+          8  : result := ftInteger;   {INTEGER}
+          9  : result := ftlargeint;  {QUAD ?}
+          7  : result := ftSmallint;  {SMALLINT}
+          12 : result := ftDate;      {DATE dialect 3}
+          13 : result := ftTime;      {TIME}
+          35 : result := ftDateTime;  {TIMESTAMP dialect 3, DATE in dialect 1,2}
+          else result := ftUnknown;
+        end;
+      end;
+  end;
+  
+  {Opmerking: bestaande fielddefs die niet meer in de tabel zitten worden niet verwijderd !? }
+  
+  function ImportFieldDef : boolean;
+  var FD : TDDFieldDef;
+      n, s : string;
+  begin
+    n := trim(FName.asstring);
+    FD := Table.Fields.FindField(n);
+    if not assigned (FD) then
+      FD := Table.AddField(n);
+    FD.FieldName := n;
+    FD.FieldType := ConvertFBFieldType (FFieldType.asinteger, FSubType.asinteger);
+    FD.Precision := FPrecision.asinteger;
+    if FScale.asinteger < 0 then
+      FD.Size := -FScale.asinteger
+    else if FD.Fieldtype in [ftString, ftFixedChar] then
+      FD.Size := FCharLength.asinteger
+    else
+      FD.Size := 0;
+      { // Fixed length types don't have a size in the dictionary
+      case byte(FFieldType.asinteger and $FF) of
+        7 : FD.Size := 2;
+        10,8 : FD.Size := 4;
+        35,11,27,9,16,12 : FD.Size := 8;
+      end; }
+    if not fDescription.IsNull then
+      FD.Hint := FDescription.asstring;
+    s := trim(FFieldDefault.asstring);
+    n := trim(FDomainDefault.asstring);
+    if s <> '' then
+      FD.DefaultExpression:=s
+    else if n <> '' then;
+      FD.DefaultExpression:=n;
+    if FFieldnull.asinteger = 1 then
+      FD.Required:=true
+    else if FDomainnull.asinteger = 1 then
+      FD.Required:=true
+    else
+      FD.Required:=false;
+    FD.index := FPosition.AsInteger;
+    result := true;
+  end;
+  
+  function ImportFromSQLDef : integer;
+  begin
+    result := 0;
+    Q.First;
+    BindFields;
+    while not Q.eof do
+      begin
+      if ImportFieldDef then
+        inc (result);
+      Q.Next;
+      end;
+  end;
   
 begin
   Q:=CreateSQLQuery(Nil);
@@ -131,7 +260,7 @@ begin
     Q.Sql.Text:=Format(SQL,[Table.TableName]);
     Q.Open;
     try
-      Result:=Table.ImportFromDataset(Q);
+      result := ImportFromSQLDef;
     finally
       Q.CLose;
     end;