fcl-db: datadict: mssql: add support for querying sequences and domains using standard INFORMATION_SCHEMA views (supported since version 2000)

git-svn-id: trunk@32851 -

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

@@ -24,19 +24,22 @@ uses
   
 Type
 
-  { TFPDDFBSQLEngine }
+  { TFPDDMSSQLEngine }
 
   TFPDDMSSQLEngine = Class(TFPDDSQLEngine)
   Public
-    Function  CreateSequenceSQL(Sequence : TDDSequenceDef) : String; override;
+    Function  CreateDomainSQL(Domain : TDDDomainDef) : String; override;
   end;
 
+  { TSQLDBMSSQLDDEngine }
+
   TSQLDBMSSQLDDEngine = Class(TSQLDBDDEngine)
   Protected
     Function CreateConnection(AConnectString  : String) : TSQLConnection; override;
   Public
     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;
@@ -73,8 +76,8 @@ end;
 
 class function TSQLDBMSSQLDDEngine.EngineCapabilities: TFPDDEngineCapabilities;
 begin
-  Result:=[ecImport,ecCreateTable,ecViewTable, ecTableIndexes,
-           ecRunQuery, ecRowsAffected, ecSequences];
+  Result:=[ecImport, ecCreateTable, ecViewTable, ecTableIndexes,
+           ecRunQuery, ecRowsAffected, ecSequences, ecDomains];
 end;
 
 class function TSQLDBMSSQLDDEngine.Description: string;
@@ -84,33 +87,30 @@ end;
 
 class function TSQLDBMSSQLDDEngine.DBType: String;
 begin
-  Result:='MS-SQL Server';
+  Result:='Microsoft SQL Server';
 end;
 
 
 function TSQLDBMSSQLDDEngine.ImportIndexes(Table: TDDTableDef): Integer;
 
 const
-  SQLindexes = 'SELECT '+
-     '  TableName = t.name, '+
-     '  IndexName = ind.name, '+
-     '  IndexId = ind.index_id, '+
-     '  ColumnId = ic.index_column_id, '+
-     '  ColumnName = col.name, '+
-     '  IsUniqueIndex = ind.is_unique, '+
-     '  IsConstraint = ind.is_unique_constraint '+
-     '  ind.*, '+
-     '  ic.*, '+
-     '  col.* '+
-     '  FROM '+
-     '    sys.indexes ind ' +
-     '    INNER JOIN sys.index_columns ic ON  ind.object_id = ic.object_id and ind.index_id = ic.index_id '+
-     '    INNER JOIN sys.columns col ON ic.object_id = col.object_id and ic.column_id = col.column_id '+
-     '    INNER JOIN sys.tables t ON ind.object_id = t.object_id '+
-     '  WHERE '+
-     '    AND (t.name=:TableName) '+
-     '  ORDER BY '+
-     '    t.name, ind.name, ind.index_id, ic.index_column_id ';
+  SQL_Indexes = 'SELECT '+
+     '  t.name AS TableName, '+
+     '  ind.name AS IndexName, '+
+     '  ind.index_id AS IndexId, '+
+     '  ic.index_column_id AS ColumnId, '+
+     '  col.name AS ColumnName, '+
+     '  ind.is_unique AS IsUniqueIndex, '+
+     '  ind.is_unique_constraint AS IsConstraint '+
+     'FROM '+
+     '  sys.indexes ind ' +
+     '  INNER JOIN sys.index_columns ic ON  ind.object_id = ic.object_id and ind.index_id = ic.index_id '+
+     '  INNER JOIN sys.columns col ON ic.object_id = col.object_id and ic.column_id = col.column_id '+
+     '  INNER JOIN sys.tables t ON ind.object_id = t.object_id '+
+     'WHERE '+
+     '  t.name=:TableName '+
+     'ORDER BY '+
+     '  t.name, ind.name, ind.index_id, ic.index_column_id ';
       
         
 Var
@@ -121,7 +121,7 @@ Var
   begin
     FIndexName := Q.FieldByName ('IndexName');
     FFieldName := Q.FieldbyName('ColumnName');
-    FUnique :=Q.FieldByName('IsUniqueIndex');
+    FUnique     := Q.FieldByName('IsUniqueIndex');
     FConstraint := Q.FieldByName('IsConstraint');
   end;
 
@@ -148,12 +148,12 @@ begin
   IndName:='';
   IDD:=Nil;
   Q:=CreateSQLQuery(Nil);
-  Q.SQL.text := SQLindexes;
+  Q.SQL.text := SQL_Indexes;
   Q.Params[0].AsString:=Table.TableName;
   Q.Open;
   try
     BindIndexFields;
-    while not Q.eof do
+    while not Q.Eof do
       begin
       if IndName<>FIndexName.AsString then
         begin
@@ -165,7 +165,7 @@ begin
         end;
       if FN<>'' then
         FN:=FN+';';
-      FN:=FN+Trim(FFieldName.asstring);
+      FN:=FN+Trim(FFieldName.AsString);
       Q.Next;
       end;
     if (IDD<>Nil) then
@@ -179,10 +179,7 @@ function TSQLDBMSSQLDDEngine.ImportSequences(Sequences: TDDSequenceDefs;
   List: TStrings; UpdateExisting: boolean): Integer;
 
 const
-  SQL = 'SELECT '+
-        '  seq.name AS TheSequenceName, seq.start_value AS TheStartValue, seq.increment as TheIncrement '+
-        'FROM '+
-        '  sys.sequences AS seq ';
+  SQL_Sequences = 'SELECT SEQUENCE_NAME, START_VALUE, INCREMENT FROM INFORMATION_SCHEMA.SEQUENCES';
 
 Var
   Q : TSQLQuery;
@@ -193,12 +190,12 @@ begin
   result := 0;
   Q:=CreateSQLQuery(Nil);
   try
-    Q.Sql.Text := SQL;
+    Q.Sql.Text := SQL_Sequences;
     Q.Open;
     try
       while not Q.eof do
         begin
-        n := trim(Q.Fields[0].asstring);
+        n := trim(Q.Fields[0].AsString);
         seq := Sequences.FindSequence(n);
         if not assigned (Seq) then
           Seq := Sequences.AddSequence(n)
@@ -206,8 +203,8 @@ begin
           Seq := nil;
         if assigned (Seq) then
           begin
-          Seq.StartValue := Round(Q.FIelds[1].AsFloat);
-          Seq.Increment := Round(Q.FIelds[2].AsFloat);
+          Seq.StartValue := Round(Q.Fields[1].AsFloat);
+          Seq.Increment := Round(Q.Fields[2].AsFloat);
           inc (result);
           end;
         Q.Next;
@@ -220,6 +217,74 @@ begin
   end;
 end;
 
+function TSQLDBMSSQLDDEngine.ImportDomains(Domains: TDDDomainDefs;
+  List: TStrings; UpdateExisting: boolean): Integer;
+
+const
+  SQL_Domains = 'SELECT * FROM INFORMATION_SCHEMA.DOMAINS';
+
+Var
+  Q : TSQLQuery;
+  FName, FDomainName, FDomainDefault,
+  FCharLength, FPrecision, FScale, FDataType : TField;
+
+  procedure BindFields;
+  begin
+    FName := Q.fieldbyname('DOMAIN_NAME');
+    FDomainDefault := q.fieldbyname('DOMAIN_DEFAULT');
+    FCharLength := q.fieldbyname('CHARACTER_MAXIMUM_LENGTH');
+    FPrecision := q.fieldbyname('NUMERIC_PRECISION');
+    FScale := q.fieldbyname('NUMERIC_SCALE');
+    FDataType := q.fieldbyname('DATA_TYPE');
+  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 := SQLDataTypeToFieldType(FDataType.AsString);
+      Dom.Precision := FPrecision.AsInteger;
+      if Dom.FieldType in [ftFloat, ftBcd, ftFmtBCD] then
+        Dom.Size := FScale.AsInteger
+      else if Dom.FieldType in [ftString, ftFixedChar] then
+        Dom.Size := FCharLength.AsInteger
+      else
+        Dom.Size := 0;
+      end
+    else
+      result := false;
+  end;
+
+begin
+  result := 0;
+  Q:=CreateSQLQuery(Nil);
+  try
+    Q.Sql.Text := SQL_Domains;
+    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 TSQLDBMSSQLDDEngine.CreateSQLEngine: TFPDDSQLEngine;
 begin
@@ -228,13 +293,11 @@ end;
 
 { TFPDDMSSQLEngine }
 
-function TFPDDMSSQLEngine.CreateSequenceSQL(Sequence: TDDSequenceDef): String;
+function TFPDDMSSQLEngine.CreateDomainSQL(Domain: TDDDomainDef): String;
 begin
-  Result:='CREATE SEQUENCE '+Sequence.SequenceName;
-  if Sequence.StartValue<>0 then
-    Result:=Result+ ' STAR WITH ' +IntToStr(Sequence.StartValue);
-  if Sequence.Increment<>0 then
-    Result:=Result+ ' INCREMENT BY ' +IntToStr(Sequence.Increment);
+  Result:='CREATE TYPE '+Domain.DomainName+' FROM '+FieldTypeString(Domain.FieldType,Domain.Size,Domain.Precision);
+  if Domain.Required then
+    Result:=Result+' NOT NULL';
 end;
 
 end.

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

@@ -30,6 +30,7 @@ Type
   Private
     FConn: TSQLConnection;
   Protected
+    Function SQLDataTypeToFieldType(const SQLDataType: string) : TFieldType; virtual;
     Function CreateConnection(AConnectString  : String) : TSQLConnection; virtual; abstract;
     Function CreateSQLQuery(ADatasetOwner: TComponent) : TSQLQuery;
     Property Connection : TSQLConnection Read FConn;
@@ -74,6 +75,25 @@ begin
   Result:=True;
 end;
 
+function TSQLDBDDEngine.SQLDataTypeToFieldType(const SQLDataType: string
+  ): TFieldType;
+begin
+  // ANSI standard types
+  case SQLDataType of
+    'char'    : Result := ftFixedChar;
+    'varchar' : Result := ftString;
+    'smallint': Result := ftSmallint;
+    'int',
+    'integer' : Result := ftInteger;
+    'bigint'  : Result := ftLargeInt;
+    'float'   : Result := ftFloat;
+    'date'    : Result := ftDate;
+    'time'    : Result := ftTime;
+    'datetime': Result := ftDateTime;
+    else        Result := ftUnknown;
+  end;
+end;
+
 function TSQLDBDDEngine.CreateSQLQuery(ADatasetOwner: TComponent): TSQLQuery;
 begin
   Result:=TSQLQuery.Create(ADatasetOwner);
@@ -124,7 +144,7 @@ end;
 function TSQLDBDDEngine.ImportFields(Table: TDDTableDef): Integer;
 
 Const
-  SQL = 'SELECT * from %s where (1=0)';
+  SQL = 'SELECT * FROM %s WHERE (1=0)';
 
 Var
   Q : TSQLQuery;
@@ -145,7 +165,7 @@ begin
 end;
 
 
-Function TSQLDBDDEngine.ImportIndexes(Table : TDDTableDef) : Integer;
+function TSQLDBDDEngine.ImportIndexes(Table: TDDTableDef): Integer;
 begin
 end;
 
@@ -209,7 +229,7 @@ begin
   Try
     Q.Database:=FConn;
     Q.Transaction:=FConn.Transaction;
-    Q.SQL.text:=Format('SELECT * FROM %s WHERE (1=2)',[ATAbleName]);
+    Q.SQL.text:=Format('SELECT * FROM %s WHERE (1=2)',[ATableName]);
     Q.ReadOnly:=False;
     Q.Prepare;
     Q.IndexDefs.Update;
@@ -222,7 +242,7 @@ end;
 
 class function TSQLDBDDEngine.EngineCapabilities: TFPDDEngineCapabilities;
 begin
-  Result:=[ecimport,ecViewTable, ecRunQuery, ecTableIndexes];
+  Result:=[ecImport, ecViewTable, ecRunQuery, ecTableIndexes];
 end;
 
 end.