* Initial MS-SQL server support for Data Dictionary

git-svn-id: trunk@32831 -

.gitattributes

@@ -2126,6 +2126,7 @@ packages/fcl-db/src/datadict/fpdatadict.pp svneol=native#text/plain
 packages/fcl-db/src/datadict/fpdddbf.pp svneol=native#text/plain
 packages/fcl-db/src/datadict/fpdddiff.pp svneol=native#text/plain
 packages/fcl-db/src/datadict/fpddfb.pp svneol=native#text/plain
+packages/fcl-db/src/datadict/fpddmssql.pp svneol=native#text/plain
 packages/fcl-db/src/datadict/fpddmysql40.pp svneol=native#text/plain
 packages/fcl-db/src/datadict/fpddmysql41.pp svneol=native#text/plain
 packages/fcl-db/src/datadict/fpddmysql50.pp svneol=native#text/plain

packages/fcl-db/fpmake.pp

@@ -464,6 +464,14 @@ begin
           AddUnit('fpddsqldb');
           AddUnit('pqconnection');
         end;
+    T:=P.Targets.AddUnit('fpddmssql.pp', DatadictOSes*MSSQLOSes);
+      with T.Dependencies do
+        begin
+          AddUnit('sqldb');
+          AddUnit('fpdatadict');
+          AddUnit('fpddsqldb');
+          AddUnit('mssqlconn');
+        end;
     T:=P.Targets.AddUnit('fpddregstd.pp', DatadictOSes-SqldbWithoutOracleOSes);
       with T.Dependencies do
         begin
@@ -476,6 +484,7 @@ begin
           AddUnit('fpddmysql40');
           AddUnit('fpddmysql41');
           AddUnit('fpddmysql50');
+          AddUnit('fpddmssql');
           AddUnit('fpddodbc');
         end;
     T:=P.Targets.AddUnit('customsqliteds.pas', SqliteOSes);

packages/fcl-db/src/datadict/buildd.lpi

@@ -1,17 +1,20 @@
-<?xml version="1.0"?>
+<?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <ProjectOptions>
-    <PathDelim Value="/"/>
+    <Version Value="9"/>
-    <Version Value="6"/>
     <General>
+      <Flags>
+        <LRSInOutputDirectory Value="False"/>
+      </Flags>
       <SessionStorage Value="InProjectDir"/>
       <MainUnit Value="0"/>
-      <IconPath Value="./"/>
-      <TargetFileExt Value=""/>
     </General>
     <VersionInfo>
-      <ProjectVersion Value=""/>
+      <StringTable ProductVersion=""/>
     </VersionInfo>
+    <BuildModes Count="1">
+      <Item1 Name="default" Default="True"/>
+    </BuildModes>
     <PublishOptions>
       <Version Value="2"/>
       <IgnoreBinaries Value="False"/>
@@ -28,17 +31,14 @@
       <Unit0>
         <Filename Value="buildd.lpr"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="buildd"/>
       </Unit0>
       <Unit1>
         <Filename Value="fpddsqldb.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="fpddsqldb"/>
       </Unit1>
       <Unit2>
         <Filename Value="fpdatadict.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="fpdatadict"/>
       </Unit2>
       <Unit3>
         <Filename Value="fpdddbf.pp"/>
@@ -48,65 +48,54 @@
       <Unit4>
         <Filename Value="fpddfb.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="fpddfb"/>
       </Unit4>
       <Unit5>
         <Filename Value="fpddmysql40.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="fpddmysql40"/>
       </Unit5>
       <Unit6>
         <Filename Value="fpddmysql41.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="fpddmysql41"/>
       </Unit6>
       <Unit7>
         <Filename Value="fpddmysql50.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="fpddmysql50"/>
       </Unit7>
       <Unit8>
         <Filename Value="fpddpq.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="fpddpq"/>
       </Unit8>
       <Unit9>
         <Filename Value="fpddodbc.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="fpddodbc"/>
       </Unit9>
       <Unit10>
         <Filename Value="fpddoracle.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="fpddoracle"/>
       </Unit10>
       <Unit11>
         <Filename Value="fpddsqlite3.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="fpddsqlite3"/>
       </Unit11>
       <Unit12>
         <Filename Value="fpddregstd.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="fpddregstd"/>
       </Unit12>
       <Unit13>
         <Filename Value="fpdddiff.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="fpdddiff"/>
       </Unit13>
     </Units>
   </ProjectOptions>
   <CompilerOptions>
-    <Version Value="5"/>
+    <Version Value="11"/>
     <SearchPaths>
       <UnitOutputDirectory Value="../../units/$(TARGETCPU)-$(TARGETOS)"/>
     </SearchPaths>
-    <CodeGeneration>
+    <Parsing>
-      <Generate Value="Faster"/>
+      <SyntaxOptions>
-    </CodeGeneration>
+        <UseAnsiStrings Value="False"/>
-    <Other>
+      </SyntaxOptions>
-      <CompilerPath Value="$(CompPath)"/>
+    </Parsing>
-    </Other>
   </CompilerOptions>
 </CONFIG>

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

@@ -0,0 +1,241 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2007 by Michael Van Canneyt, member of the
+    Free Pascal development team
+
+    MS-SQL Server Data Dictionary Engine Implementation.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit fpddmssql;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, sqldb, fpdatadict, fpddsqldb, db;
+  
+Type
+
+  { TFPDDFBSQLEngine }
+
+  TFPDDMSSQLEngine = Class(TFPDDSQLEngine)
+  Public
+    Function  CreateSequenceSQL(Sequence : TDDSequenceDef) : String; override;
+  end;
+
+  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 CreateSQLEngine : TFPDDSQLEngine; override;
+    Class function EngineCapabilities : TFPDDEngineCapabilities; override;
+    Class function Description : string; override;
+    Class function DBType : String; override;
+  end;
+
+
+Procedure RegisterMSSQLDDEngine;
+Procedure UnRegisterMSSQLDDEngine;
+
+implementation
+
+uses mssqlconn;
+
+Procedure RegisterMSSQLDDEngine;
+
+begin
+  RegisterDictionaryEngine(TSQLDBMSSQLDDEngine);
+end;
+
+Procedure UnRegisterMSSQLDDEngine;
+
+begin
+  UnRegisterDictionaryEngine(TSQLDBMSSQLDDEngine);
+end;
+
+{ TSQLDBMSSQLDDEngine }
+
+function TSQLDBMSSQLDDEngine.CreateConnection(AConnectString: String
+  ): TSQLConnection;
+begin
+  Result:=TMSSQLConnection.Create(Self);
+end;
+
+class function TSQLDBMSSQLDDEngine.EngineCapabilities: TFPDDEngineCapabilities;
+begin
+  Result:=[ecImport,ecCreateTable,ecViewTable, ecTableIndexes,
+           ecRunQuery, ecRowsAffected, ecSequences];
+end;
+
+class function TSQLDBMSSQLDDEngine.Description: string;
+begin
+  Result:='Microsoft SQL Server connection using SQLDB';
+end;
+
+class function TSQLDBMSSQLDDEngine.DBType: String;
+begin
+  Result:='MS-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 ';
+      
+        
+Var
+  Q : TSQLQuery;
+  FIndexName, FFieldName, FUnique, FConstraint : TField;
+
+  procedure BindIndexFields;
+  begin
+    FIndexName := Q.FieldByName ('IndexName');
+    FFieldName := Q.FieldbyName('ColumnName');
+    FUnique :=Q.FieldByName('IsUniqueIndex');
+    FConstraint := Q.FieldByName('IsConstraint');
+  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);
+    if FUnique.AsInteger<>0 then
+      result.Options:=[ixUnique];
+  end;
+  
+
+Var
+  FN,IndName : String;
+  IDD : TDDIndexDef;
+
+begin
+  FN:='';
+  IndName:='';
+  IDD:=Nil;
+  Q:=CreateSQLQuery(Nil);
+  Q.SQL.text := SQLindexes;
+  Q.Params[0].AsString:=Table.TableName;
+  Q.Open;
+  try
+    BindIndexFields;
+    while not Q.eof do
+      begin
+      if IndName<>FIndexName.AsString then
+        begin
+        if (IDD<>Nil) then
+          IDD.Fields:=FN;
+        IndName:=FIndexName.AsString;
+        IDD:=CreateIndex('',IndName);
+        FN:='';
+        end;
+      if FN<>'' then
+        FN:=FN+';';
+      FN:=FN+Trim(FFieldName.asstring);
+      Q.Next;
+      end;
+    if (IDD<>Nil) then
+      IDD.Fields:=FN;
+  finally
+    Q.Free;
+  end;
+end;
+
+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 ';
+
+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.StartValue := Round(Q.FIelds[1].AsFloat);
+          Seq.Increment := Round(Q.FIelds[2].AsFloat);
+          inc (result);
+          end;
+        Q.Next;
+        end;
+    finally
+      Q.CLose;
+    end;
+  finally
+    Q.Free;
+  end;
+end;
+
+
+function TSQLDBMSSQLDDEngine.CreateSQLEngine: TFPDDSQLEngine;
+begin
+  Result:=TFPDDMSSQLEngine.Create;
+end;
+
+{ TFPDDMSSQLEngine }
+
+function TFPDDMSSQLEngine.CreateSequenceSQL(Sequence: TDDSequenceDef): 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);
+end;
+
+end.
+

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

@@ -36,12 +36,12 @@ uses
 
 Type
   TDataDictEngine = (teDBF,teFirebird,teOracle,teMySQL40,teMySQL41,teMySQL50,
-                       tePostgreSQL,teSQLite3,teODBC);
+                       tePostgreSQL,teSQLite3,teODBC, teMSSQL);
   TDataDictEngines = set of TDataDictEngine;
 
 Const
   AllStdDDEngines = [teDBF,teFirebird,teOracle,teMySQL40,teMySQL41,teMySQL50,
-                     tePostgreSQL,teSQLite3,teODBC];
+                     tePostgreSQL,teSQLite3,teODBC,teMSSQL];
                      
 Type
 
@@ -78,6 +78,7 @@ uses
   fpddmysql40,
   fpddmysql41,
   fpddmysql50,
+  fpddmssql,
   fpddodbc;
   
 Const
@@ -86,19 +87,19 @@ Const
                    = (TDBFDDEngine, TSQLDBFBDDEngine, TSQLDBOracleDDEngine,
                       TSQLDBMySql40DDEngine, TSQLDBMySql41DDEngine ,
                       TSQLDBMySql5DDEngine, TSQLDBPostGreSQLDDEngine,
-                      TSQLDBSQLite3DDEngine,TSQLDBODBCDDEngine);
+                      TSQLDBSQLite3DDEngine,TSQLDBODBCDDEngine, TSQLDBMSSQLDDEngine);
 
   StdEngineRegs : Array [TDataDictEngine] of procedure
                 = (@InitDBFImporter, @RegisterFBDDEngine, @RegisterOracleDDEngine,
                   @RegisterMySQL40DDEngine, @RegisterMySQL41DDEngine,
                   @RegisterMySQL50DDEngine, @RegisterPostgreSQLDDengine,
-                  @RegisterSQLite3DDEngine, @RegisterODBCDDengine);
+                  @RegisterSQLite3DDEngine, @RegisterODBCDDengine,@RegisterMSSQLDDEngine);
 
   StdEngineUnRegs : Array [TDataDictEngine] of procedure
                 = (@DoneDBFImporter, @UnRegisterFBDDEngine, @UnRegisterOracleDDEngine,
                   @UnRegisterMySQL40DDEngine, @UnRegisterMySQL41DDEngine,
                   @UnRegisterMySQL50DDEngine, @UnRegisterPostgreSQLDDengine,
-                  @UnRegisterSQLite3DDEngine, @UnRegisterODBCDDengine);
+                  @UnRegisterSQLite3DDEngine, @UnRegisterODBCDDengine,@UnRegisterMSSQLDDEngine);
                   
 function RegisterStdDDEngines(Engines: TDataDictEngines): TDataDictEngines;