mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-20 04:39:28 +02:00
* Initial MS-SQL server support for Data Dictionary
git-svn-id: trunk@32831 -
This commit is contained in:
michael
parent
ff7a0c5235
commit
7c66a42eaf
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -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
|
||||
|
||||
@ -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);
|
||||
|
||||
@ -1,17 +1,20 @@
|
||||
<?xml version="1.0"?>
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<PathDelim Value="/"/>
|
||||
<Version Value="6"/>
|
||||
<Version Value="9"/>
|
||||
<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>
|
||||
<Generate Value="Faster"/>
|
||||
</CodeGeneration>
|
||||
<Other>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
<Parsing>
|
||||
<SyntaxOptions>
|
||||
<UseAnsiStrings Value="False"/>
|
||||
</SyntaxOptions>
|
||||
</Parsing>
|
||||
</CompilerOptions>
|
||||
</CONFIG>
|
||||
|
||||
241
packages/fcl-db/src/datadict/fpddmssql.pp
Normal file
241
packages/fcl-db/src/datadict/fpddmssql.pp
Normal file
@ -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.
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user