* Finished support for sequences and domains

git-svn-id: trunk@11616 -

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

@@ -231,6 +231,7 @@ Type
     FTableName: String;
     function GetOnProgress: TDDProgressEvent;
     function GetPrimaryKeyName: String;
+    function GetPrimaryIndexDef : TDDIndexDef;
     procedure SetTableName(const AValue: String);
   protected
     function GetSectionName: String; override;
@@ -245,10 +246,13 @@ Type
     Function AddField(AFieldName : String = '') : TDDFieldDef;
     Procedure SaveToIni(Ini: TCustomInifile; ASection : String); override;
     Procedure LoadFromIni(Ini: TCustomInifile; ASection : String); override;
+    procedure PrimaryIndexToFields;
+    procedure FieldsToPrimaryIndex;
     Property Fields : TDDFieldDefs Read FFieldDefs;
     Property Indexes : TDDIndexDefs Read FIndexDefs;
     Property ForeignKeys : TDDForeignKeyDefs Read FKeyDefs;
     Property OnProgress : TDDProgressEvent Read GetOnProgress;
+    Property PrimaryIndexDef : TDDIndexDef read GetPrimaryIndexDef;
   Published
     Property TableName : String Read FTableName Write SetTableName;
     Property PrimaryKeyConstraintName : String Read GetPrimaryKeyName Write FPrimaryKeyName;
@@ -545,17 +549,22 @@ Type
   Public
     Destructor Destroy; override;
     Function GetConnectString : String; virtual;
-    Function ImportTables(Tables : TDDTableDefs; List : TStrings; UpdateExisting : Boolean) : Integer;
     // Mandatory for all data dictionary engines.
     Class function Description : string; virtual; abstract;
     Class function DBType : String; virtual; abstract;
     Class function EngineCapabilities : TFPDDEngineCapabilities; virtual;
     Function Connect(const ConnectString : String) : Boolean; virtual; abstract;
     Procedure Disconnect ; virtual; abstract;
+    procedure ImportDatadict (Adatadict: TFPDataDictionary; UpdateExisting : Boolean);
     Function GetTableList(List : TStrings) : Integer; virtual; abstract;
+    Function ImportTables(Tables : TDDTableDefs; List : TStrings; UpdateExisting : Boolean) : Integer;
     Function ImportFields(Table : TDDTableDef) : Integer; virtual; abstract;
-    Function ImportDomains(Domains : TDDDomainDefs) : Integer; virtual;
-    Function ImportSequences(Sequences : TDDSequenceDefs) : Integer; virtual;
+    Function ImportIndexes(Table : TDDTableDef) : Integer; virtual; abstract;
+    function GetDomainList(List: TSTrings) : integer; virtual;
+    Function ImportDomains(Domains : TDDDomainDefs; List : TStrings; UpdateExisting : boolean) : Integer; virtual;
+    function GetSequenceList (List:TStrings): integer; virtual;
+    Function ImportSequences(Sequences : TDDSequenceDefs; List : TStrings; UpdateExisting : boolean) : Integer; virtual;
+
     // Override depending on capabilities
     Procedure CreateTable(Table : TDDTableDef); virtual;
     // Should not open the dataset.
@@ -1311,8 +1320,31 @@ begin
 end;
 
 function TDDTableDef.GetPrimaryKeyName: String;
+var i : TDDIndexDef;
+begin
+  if FPrimaryKeyName <> '' then
+    Result := FPrimaryKeyName
+  else
+    begin
+    I := GetPrimaryIndexDef;
+    if assigned (I) then
+      Result := I.IndexName
+    else
+      Result:=Tablename+'_PK';
+    end;
+end;
+
+function TDDTableDef.GetPrimaryIndexDef: TDDIndexDef;
+var r : integer;
 begin
-  Result:=Tablename+'_PK';
+  r := Indexes.count;
+  repeat
+    dec (r);
+  until (r < 0) or (ixPrimary in Indexes[r].Options);
+  if r < 0 then
+    result := nil
+  else
+    result := Indexes[r];
 end;
 
 function TDDTableDef.GetOnProgress: TDDProgressEvent;
@@ -1444,6 +1476,56 @@ begin
   FIndexDefs.LoadFromIni(Ini,ASection+SIndexSuffix);
 end;
 
+procedure TDDTableDef.PrimaryIndexToFields;
+var I : TDDIndexDef;
+    r : integer;
+    l : TFPDDFieldList;
+begin
+  I := GetPrimaryIndexDef;
+  if assigned (I) then
+    begin
+    for r := 0 to Fields.count-1 do
+      Fields[r].ProviderFlags := Fields[r].ProviderFlags - [pfInKey];
+    l := TFPDDFieldList.create;
+    try
+      Fields.FillFieldList (I.Fields, l);
+      for r := 0 to l.count-1 do
+        l[r].ProviderFlags := l[r].ProviderFlags + [pfInKey];
+    finally
+      l.Free;
+    end;
+    end;
+end;
+
+procedure TDDTableDef.FieldsToPrimaryIndex;
+var I : TDDIndexDef;
+    r : integer;
+    s : string;
+begin
+  I := GetPrimaryIndexDef;
+  s := '';
+  for r := 0 to fields.count-1 do
+    if pfInKey in fields[r].ProviderFlags then
+      s := s + ';' + fields[r].FieldName;
+  if s = '' then
+    begin
+    if assigned (I) then
+      I.Free;
+    end
+  else
+    begin
+    s := copy(s, 2, maxint);
+    if assigned (I) then
+      I.Fields := s
+    else
+      begin
+      I := Indexes.AddIndex(GetPrimaryKeyName);
+      I.Fields := s;
+      I.Options := I.Options + [ixPrimary];
+      end;
+    end;
+end;
+
 { ---------------------------------------------------------------------
   TDDTableDefs
   ---------------------------------------------------------------------}
@@ -1774,18 +1856,26 @@ begin
     TD:=Nil;
     j:=Tables.IndexOfTable(List[i]);
     If (J=-1) then
-      TD:=Tables.AddTAble(List[i])
+      TD:=Tables.AddTable(List[i])
     else if UpdateExisting then
       TD:=Tables[J];
     If (TD<>nil) then
       begin
       DoProgress(Format(SDDImportingTable,[TD.TableName]));
       ImportFields(TD);
+      if ecTableIndexes in EngineCapabilities then
+        ImportIndexes(TD);
       Inc(Result);
       end
     end;
 end;
 
+function TFPDDEngine.GetDomainList(List: TSTrings): integer;
+begin
+  List.Clear;
+  result := 0;
+end;
+
 function TFPDDEngine.CreateSQLEngine: TFPDDSQLEngine;
 begin
   Result:=TFPDDSQLEngine.Create;
@@ -1796,14 +1886,68 @@ begin
   Result:=[];
 end;
 
-function TFPDDEngine.ImportDomains(Domains: TDDDomainDefs): Integer;
+procedure TFPDDEngine.ImportDatadict(Adatadict: TFPDatadictionary;
+  UpdateExisting: Boolean);
+var L : TStringList;
+    r : integer;
 begin
-  Domains.Clear;
+  l := TStringlist.Create;
+  try
+    if ecDomains in EngineCapabilities then
+      begin
+      GetDomainList (L);
+      if UpdateExisting then // Delete domains that don't exist anymore
+        begin
+        for r := ADatadict.Domains.count-1 downto 0 do
+          if L.indexOf(ADatadict.Domains[r].DomainName) < 0 then
+            ADatadict.Domains[r].Free;
+        end;
+      ImportDomains (ADatadict.Domains, L, UpdateExisting);
+      end;
+
+    L.Clear;
+    GetTableList (L);
+    if UpdateExisting then // delete tables that don't exist anymore
+      begin
+      for r := ADatadict.Tables.count-1 downto 0 do
+        if L.indexOf(ADatadict.Tables[r].TableName) < 0 then
+          ADatadict.Tables[r].Free;
+      end;
+    ImportTables (ADatadict.Tables, L, UpdateExisting);
+
+    if ecSequences in EngineCapabilities then
+      begin
+      L.Clear;
+      GetSequenceList (L);
+      if UpdateExisting then // Delete sequences that don't exist anymore
+        begin
+        for r := ADatadict.Sequences.count-1 downto 0 do
+          if L.indexOf(ADatadict.Sequences[r].SequenceName) < 0 then
+            ADatadict.Sequences[r].Free;
+        end;
+      ImportSequences (ADatadict.Sequences, L, UpdateExisting);
+      end;
+  finally
+    L.Free;
+  end;
+end;
+
+function TFPDDEngine.ImportDomains(Domains: TDDDomainDefs; List : TStrings; UpdateExisting : boolean) : Integer;
+begin
+  result := 0;
+  writeln ('importing no domains');
+end;
+
+function TFPDDEngine.GetSequenceList(List: TStrings): integer;
+begin
+  List.Clear;
+  result := 0;
 end;
 
-function TFPDDEngine.ImportSequences(Sequences: TDDSequenceDefs): Integer;
+function TFPDDEngine.ImportSequences(Sequences: TDDSequenceDefs; List : TStrings; UpdateExisting : boolean) : Integer;
 begin
-  Sequences.Clear;
+  result := 0;
+  writeln ('importing no sequences');
 end;
 
 procedure TFPDDEngine.CreateTable(Table: TDDTableDef);
@@ -1986,7 +2130,10 @@ end;
 function TFPDDSQLEngine.FieldTypeString(FD : TDDFieldDef) : String;
 
 begin
-  Result:=FieldTypeString(FD.FieldType,FD.Size,FD.Precision);
+  if FD.DomainName <> '' then
+    Result := FD.DomainName
+  else
+    Result:=FieldTypeString(FD.FieldType,FD.Size,FD.Precision);
 end;
 
 
@@ -2390,15 +2537,9 @@ begin
     KF:=TFPDDFieldlist.Create(False);
     try
       KF.OwnsObjects:=False;
-      I:=0;
-      While (I<TableDef.Indexes.Count) and (KF.Count=0) do
-        begin
-        ID:=TableDef.Indexes[i];
-        If (ixPrimary in ID.Options) then
-          TableDef.Fields.FillFieldList(ID.Fields,KF);
-        Inc(I);
-        end;
-      If (KF.Count=0) then
+      if assigned (TableDef.PrimaryIndexDef) then
+        TableDef.fields.FillFieldList(TableDef.PrimaryIndexDef.Fields, KF)
+      else
         For I:=0 to TableDef.Fields.Count-1 do
           begin
           FD:=TableDef.Fields[I];
@@ -2460,7 +2601,8 @@ Var
 
 begin
   For I:=0 to Indexes.Count-1 do
-    SQL.Add(CreateIndexSQL(Indexes[i])+TerminatorChar);
+    if not (ixPrimary in Indexes[i].Options) then
+      SQL.Add(CreateIndexSQL(Indexes[i])+TerminatorChar);
 end;
 
 procedure TFPDDSQLEngine.CreateSequencesSQLStrings(Sequences: TFPDDSequenceList;
@@ -2822,9 +2964,10 @@ end;
 function TDDDomainDefs.IndexOfDomain(ADomainName: String): Integer;
 
 begin
-  Result:=Count-1;
-  While (Result>=0) and (CompareText(GetDomain(Result).DomainName,ADomainName)=0) do
+  Result := Count;
+  repeat
     Dec(Result);
+  until (Result < 0) or (CompareText(GetDomain(Result).DomainName,ADomainName) = 0);
 end;
 
 function TDDDomainDefs.FindDomain(ADomainName: String): TDDDomainDef;
@@ -3019,8 +3162,10 @@ end;
 
 function TDDSequenceDefs.IndexOfSequence(ASequenceName: String): Integer;
 begin
-  While (Result>=0) and (CompareText(GetSequence(Result).SequenceName,ASequenceName)=0) do
+  result := count;
+  repeat
     Dec(Result);
+  until (Result<0) or (CompareText(GetSequence(Result).SequenceName,ASequenceName)=0);
 end;
 
 function TDDSequenceDefs.FindSequence(ASequenceName: String): TDDSequenceDef;

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

@@ -11,7 +11,7 @@
     but WITHOUT ANY WARRANTY; without even the implied warranty of
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
- **********************************************************************}
+  **********************************************************************}
 unit fpdddiff;
 
 {$mode objfpc}{$H+}
@@ -188,8 +188,8 @@ begin
     FieldDifference(dtSurplus, nil, Targ)
   else if (Not FieldTypesEqual(Src,Targ))
           or (Src.required <> Targ.required)
-          or (Src.DomainName <> Targ.DomainName)
-          or (Src.DefaultExpression <> Targ.DefaultExpression)
+          or (comparetext(Src.DomainName, Targ.DomainName) <> 0)
+          or (comparetext(Src.DefaultExpression, Targ.DefaultExpression) <> 0)
           or ((Src.Size <> Targ.Size) and not (Src.Fieldtype in [ftBlob]))
           or (Src.Precision <> Targ.Precision) then
     FieldDifference(dtDifferent, Src, Targ)

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

@@ -20,7 +20,7 @@ unit fpddfb;
 interface
 
 uses
-  Classes, SysUtils, sqldb, fpdatadict, fpddsqldb;
+  Classes, SysUtils, sqldb, fpdatadict, fpddsqldb, db;
   
 Type
 
@@ -35,12 +35,16 @@ Type
 
   TSQLDBFBDDEngine = Class(TSQLDBDDEngine)
   private
+    function ConvertFBFieldType(FDfieldtype, FBsubtype: integer): TFieldType;
   Protected
     Function CreateConnection(AConnectString  : String) : TSQLConnection; override;
   Public
-    Class function EngineCapabilities : TFPDDEngineCapabilities; virtual;
     function ImportFields(Table: TDDTableDef): Integer; override;
+    Function ImportIndexes(Table : TDDTableDef) : Integer; override;
+    Function ImportSequences(Sequences : TDDSequenceDefs; List : TStrings; UpdateExisting : boolean) : Integer; override;
+    Function ImportDomains(Domains : TDDDomainDefs; List : TStrings; UpdateExisting : boolean) : Integer; override;
     Function CreateSQLEngine : TFPDDSQLEngine; override;
+    Class function EngineCapabilities : TFPDDEngineCapabilities; override;
     Class function Description : string; override;
     Class function DBType : String; override;
   end;
@@ -54,7 +58,7 @@ Procedure UnRegisterFBDDEngine;
 
 implementation
 
-uses ibconnection, db;
+uses ibconnection;
 
 Procedure RegisterFBDDEngine;
 
@@ -92,6 +96,323 @@ begin
   Result:='Firebird/Interbase';
 end;
 
+function TSQLDBFBDDEngine.ConvertFBFieldType (FDfieldtype, FBsubtype : integer) : TFieldType;
+var b : byte;
+begin
+  if FDFieldType > 255 then
+    begin
+    if FDFieldType = 261 then
+      result := ftBlob       {BLOB}
+    else
+      result := ftUnknown;
+    end
+  else
+    begin
+    b := byte(FDFieldType 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;
+
+function TSQLDBFBDDEngine.ImportIndexes(Table: TDDTableDef): Integer;
+const
+  SQLindexes = 'SELECT '+
+        'I.RDB$INDEX_NAME as IndexName, '+
+        'I.RDB$INDEX_TYPE as IndexType, '+
+        'I.RDB$UNIQUE_FLAG as IsUnique, '+
+        'R.RDB$CONSTRAINT_TYPE as ConstraintType, '+
+        'R.RDB$CONSTRAINT_NAME as ConstraintName '+
+        'FROM '+
+        'RDB$INDICES I '+
+        'LEFT JOIN RDB$RELATION_CONSTRAINTS R ON I.RDB$INDEX_NAME = R.RDB$INDEX_NAME '+
+        'WHERE '+
+        'I.RDB$RELATION_NAME=''%s'' '+
+        'AND I.RDB$FOREIGN_KEY is null '+
+        'ORDER BY I.RDB$INDEX_NAME';
+
+  {
+  SQLchecks = 'SELECT '+
+        'R.RDB$CONSTRAINT_NAME as ConstraintName, '+
+        'R.RDB$CONSTRAINT_TYPE as ConstraintType, '+
+        'T.RDB$TRIGGER_SOURCE as CheckSource, '+
+        'FROM '+
+        'RDB$RELATION_CONSTRAINTS R '+
+        'LEFT JOIN RDB$CHECK_CONSTRAINTS C ON R.RDB$CONSTRAINT_NAME = C.RDB$CONSTRAINT_NAME '+
+        'LEFT JOIN RDB$TRIGGERS T ON T.RDB$TRIGGER_NAME = C.RDB$TRIGGER_NAME '+
+        'WHERE '+
+        'R.RDB$RELATION_NAME=''%s'' '+
+        'ORDER BY R.RDB$CONSTRAINT_NAME';
+
+  SQLforeign = 'SELECT '+
+        'R.RDB$CONSTRAINT_NAME as ConstraintName, '+
+        'R.RDB$INDEX_NAME as IndexName, '+
+        'E.RDB$CONST_NAME_UQ as RefUnique, '+
+        'E.RDB$UPDATE_RULE as OnUpdate, '+
+        'E.RDB$DELETE_RULE as OnDelete, '+
+        'I.RDB$INDEX_TYPE as IndexType '+
+        'FROM '+
+        'RDB$RELATION_CONSTRAINTS R '+
+        'LEFT JOIN RDB$REF_CONSTRAINTS E ON E.RDB$CONSTRAINT_NAME = R.RDB$CONSTRAINT_NAME '+
+        'LEFT JOIN RDB$INDICES I ON I.RDB$INDEX_NAME = R.RDB$INDEX_NAME '+
+        'WHERE '+
+        'R.RDB$RELATION_NAME=''%s'' '+
+        'ORDER BY R.RDB$CONSTRAINT_NAME';
+  }
+  SQLFields = 'SELECT RDB$FIELD_NAME as IndexField '+
+              'FROM RDB$INDEX_SEGMENTS '+
+              'WHERE RDB$INDEX_NAME = :IndexName '+
+              'ORDER BY RDB$FIELD_POSITION';
+        
+Var
+  Q, QF : TSQLQuery;
+  PIndexName : TParam;
+  FConstraintName, FConstraintType,
+  FIndexType, FIndexName, FUnique : TField;
+  //FCheckSource, FRefUnique,
+  //FOnUpdate, FOnDelete : TField;
+  Index : TDDIndexDef;
+
+  procedure BindIndexFields;
+  begin
+    PIndexName := QF.params.parambyname ('IndexName');
+    FConstraintName := Q.Fieldbyname('ConstraintName');
+    FConstraintType := Q.Fieldbyname('ConstraintType');
+    FIndexType := Q.Fieldbyname('IndexType');
+    FIndexName := Q.Fieldbyname('IndexName');
+    FUnique := Q.Fieldbyname('IsUnique');
+  end;
+  {
+  procedure BindCheckFields;
+  begin
+    FCheckSource := Q.Fieldbyname('CheckSource');
+  end;
+  
+  procedure BindForeignFields;
+  begin
+    FRefUnique := Q.Fieldbyname('RefUnique');
+    FOnUpdate := Q.Fieldbyname('OnUpdate');
+    FOnDelete := Q.Fieldbyname('OnDelete');
+  end;
+  }
+  function CreateIndex (AName, indexname: string) : TDDIndexDef;
+  var n, s : string;
+  begin
+    n := trim(AName);
+    if n = '' then
+      n := trim(indexname);
+    if trim (indexName) = '' then
+      indexname := AName;
+    result := Table.Indexes.AddIndex(n);
+    PIndexName.asstring := indexname;
+    QF.Open;
+    try
+      s := trim(QF.Fields[0].asstring);
+      QF.Next;
+      while not QF.eof do
+        begin
+        s := s + ';' + trim(QF.Fields[0].asstring);
+        QF.Next;
+        end;
+    finally
+      QF.Close;
+    end;
+    result.Fields := s;
+  end;
+  
+  function ImportIndices : integer;
+  begin
+    result := 0;
+    Q.SQL.text := format (SQLindexes, [Table.TableName]);
+    Q.Open;
+    try
+      result := 0;
+      Q.First;
+      BindIndexFields;
+      while not Q.eof do
+        begin
+        with CreateIndex (FConstraintName.asstring, FIndexName.asstring) do
+          begin
+          inc (result);
+          if trim(FConstraintType.asstring) = 'PRIMARY KEY' then
+            options := options + [ixPrimary]
+          else if FUnique.asinteger = 1 then
+            options := options + [ixUnique];
+          if FIndextype.asinteger = 1 then
+            options := options + [ixDescending];
+          end;
+        Q.Next;
+        end;
+    finally
+      Q.Close;
+    end;
+  end;
+
+begin
+  Q:=CreateSQLQuery(Nil);
+  try
+    QF:=CreateSQLQuery(Nil);
+    try
+      QF.SQl.Text := SQLFields;
+      QF.Prepare;
+      try
+        ImportIndices;
+        //ImportChecks;
+        //ImportForeignKeys;
+      finally
+        QF.Unprepare;
+      end;
+    finally
+      QF.Free;
+    end;
+  finally
+    Q.Free;
+  end;
+end;
+
+function TSQLDBFBDDEngine.ImportSequences(Sequences: TDDSequenceDefs;
+  List: TStrings; UpdateExisting: boolean): Integer;
+
+const
+  SQL = 'SELECT RDB$GENERATOR_Name FROM RDB$Generators WHERE RDB$System_Flag = 0';
+  
+Var
+  Q : TSQLQuery;
+  Seq : TDDSequenceDef;
+  n : string;
+
+begin
+  result := 0;
+  Q:=CreateSQLQuery(Nil);
+  try
+    Q.Sql.Text := SQL;
+    Q.Open;
+    try
+      while not Q.eof do
+        begin
+        n := trim(Q.Fields[0].asstring);
+        seq := Sequences.FindSequence(n);
+        if not assigned (Seq) then
+          Seq := Sequences.AddSequence(n)
+        else if not UpdateExisting then
+          Seq := nil;
+        if assigned (Seq) then
+          begin
+          Seq.Increment := 0;
+          Seq.StartValue := 0;
+          inc (result);
+          end;
+        Q.Next;
+        end;
+    finally
+      Q.CLose;
+    end;
+  finally
+    Q.Free;
+  end;
+end;
+
+function TSQLDBFBDDEngine.ImportDomains(Domains: TDDDomainDefs; List: TStrings;
+  UpdateExisting: boolean): Integer;
+
+const
+  SQL = 'SELECT ' +
+        ' RDB$FIELD_NAME as Name,' +
+        ' RDB$DEFAULT_SOURCE as DomainDefault,' +
+        ' RDB$FIELD_LENGTH as CharLength,' +
+        ' RDB$FIELD_PRECISION as FieldPrecision,' +
+        ' RDB$FIELD_SCALE as Scale,' +
+        ' RDB$FIELD_TYPE as FieldType,' +
+        ' RDB$FIELD_SUB_TYPE as Subtype,' +
+        ' RDB$NULL_FLAG as DomainNull' +
+        ' FROM '+
+        ' RDB$FIELDS'+
+        ' WHERE RDB$System_Flag = 0 and not (RDB$Field_Name like ''RDB$%'')';
+
+Var
+  Q : TSQLQuery;
+  FName, FDomainName, FDomainDefault,
+  FCharLength, FPrecision, FScale, FFieldType, FSubType, FDomainnull : TField;
+
+  procedure BindFields;
+  begin
+    FName := q.fieldbyname('Name');
+    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 ImportDomain : boolean;
+  var Dom : TDDDomainDef;
+      n : string;
+  begin
+    n := trim(FName.asstring);
+    Dom := Domains.FindDomain(n);
+    if not assigned (Dom) then
+      Dom := Domains.AddDomain(n)
+    else if not UpdateExisting then
+      Dom := nil;
+    if assigned (Dom) then
+      begin
+      result := true;
+      Dom.FieldType := ConvertFBFieldType (FFieldType.asinteger, FSubType.asinteger);
+      Dom.Precision := FPrecision.asinteger;
+      if FScale.asinteger < 0 then
+        Dom.Size := -FScale.asinteger
+      else if Dom.Fieldtype in [ftString, ftFixedChar] then
+        Dom.Size := FCharLength.asinteger
+      else
+        Dom.Size := 0;
+      //Dom.DefaultExpression := copy(trim(FDomainDefault.asstring), 9, maxint);
+      Dom.Required := FDomainnull.asinteger = 1;
+      end
+    else
+      result := false;
+  end;
+  
+begin
+  result := 0;
+  Q:=CreateSQLQuery(Nil);
+  try
+    Q.Sql.Text := SQL;
+    Q.Open;
+    BindFields;
+    try
+      while not Q.eof do
+        begin
+        if ImportDomain then
+          inc (result);
+        Q.Next;
+        end;
+    finally
+      Q.CLose;
+    end;
+  finally
+    Q.Free;
+  end;
+end;
+
 function TSQLDBFBDDEngine.ImportFields(Table: TDDTableDef): Integer;
 Const
   SQL = 'SELECT ' +
@@ -106,7 +427,8 @@ Const
         ' 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 ' +
+        ' D.RDB$NULL_FLAG as DomainNull,' +
+        ' D.RDB$FIELD_NAME as DName ' +
         ' FROM '+
         ' RDB$RELATION_FIELDS F left join RDB$FIELDS D on F.RDB$FIELD_Source = D.RDB$FIELD_NAME'+
         ' WHERE (RDB$RELATION_NAME = ''%s'')' +
@@ -114,8 +436,9 @@ Const
 
 Var
   Q : TSQLQuery;
-  FName, FPosition, FFieldnull, FDescription, FFieldDefault, FDomainDefault,
-  FCharLength, FPrecision, FScale, FFieldType, FSubType, FDomainnull : TField;
+  FName, FPosition, FFieldnull, FDescription, FFieldDefault,
+  FDomainDefault, FDomainnull, FDomainName,
+  FCharLength, FPrecision, FScale, FFieldType, FSubType : TField;
 
   procedure BindFields;
   begin
@@ -131,44 +454,7 @@ Var
     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;
+    FDomainName := q.fieldbyname('DName');
   end;
 
   {Opmerking: bestaande fielddefs die niet meer in de tabel zitten worden niet verwijderd !? }
@@ -201,16 +487,22 @@ Var
     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
+      FD.DefaultExpression := copy(s, 9, maxint)
+    else if n <> '' then
+      FD.DefaultExpression := copy(n, 9, maxint);
+    if FDomainnull.asinteger = 0 then
+      if FFieldnull.asinteger = 1 then
+        FD.Required:=true
+      else
+        FD.Required:=false
     else
       FD.Required:=false;
     FD.index := FPosition.AsInteger;
+    s := trim(FDomainName.asstring);
+    if copy(s, 1, 4) <> 'RDB$' then
+      FD.DomainName := s
+    else
+      FD.DomainName := '';
     result := true;
   end;
 

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

@@ -39,6 +39,7 @@ Type
     Function Connect(const AConnectString : String) : Boolean; override;
     Function GetTableList(List : TStrings) : Integer; override;
     Function ImportFields(Table : TDDTableDef) : Integer; override;
+    Function ImportIndexes(Table : TDDTableDef) : Integer; override;
     Function ViewTable(Const TableName: String; DatasetOwner : TComponent) : TDataset; override;
     Function RunQuery(SQL : String) : Integer; override;
     Function CreateQuery(SQL : String; DatasetOwner : TComponent) : TDataset; override;
@@ -141,6 +142,12 @@ begin
   end;
 end;
 
+
+Function TSQLDBDDEngine.ImportIndexes(Table : TDDTableDef) : Integer;
+begin
+end;
+
+
 function TSQLDBDDEngine.ViewTable(const TableName: String;
   DatasetOwner: TComponent): TDataset;