Componentes.Terceros.RemObj.../internal/5.0.29.665/1/Data Abstract for Delphi/Source/uDAElevateDBInterfaces.pas

269 lines
9.5 KiB
ObjectPascal

unit uDAElevateDBInterfaces;
{----------------------------------------------------------------------------}
{ Data Abstract Library - Core Library }
{ }
{ compiler: Delphi 6 and up, Kylix 3 and up }
{ platform: Win32, Linux }
{ }
{ (c)opyright RemObjects Software. all rights reserved. }
{ }
{ Using this code requires a valid license of the Data Abstract }
{ which can be obtained at http://www.remobjects.com. }
{----------------------------------------------------------------------------}
{$I DataAbstract.inc}
interface
uses uROClasses, uDAInterfaces, uDAEngine;
type
IDAElevateConnection = interface(IDAConnection)
['{30A997EA-0EBE-41D0-AD13-521DEFCDFE0D}']
end;
TDAElevateDBDriver = class(TDAEDriver)
protected
function GetDefaultConnectionType(const AuxDriver: string): string; override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
end;
TDAElevateDBConnection = class(TDAEConnection, IDAConnection, IDAElevateConnection, IDADirectoryBasedDatabase)
protected
Procedure CheckConnected;
procedure DoGetTableNames(out List: IROStrings); override;
procedure DoGetViewNames(out List: IROStrings); override;
procedure DoGetStoredProcedureNames(out List: IROStrings); override;
procedure DoGetForeignKeys(out ForeignKeys: TDADriverForeignKeyCollection); override;
procedure DoGetTableFields(const aTableName: string; out Fields: TDAFieldCollection); override;
function GetSPSelectSyntax(HasArguments: Boolean): string; override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
end;
const
ElevateDB_DriverType = 'ElevateDB';
ElevateDB_ConfigDBName = 'Configuration';
procedure ElevateDB_RegisterDatabase(Query: IDADataset; ADataBaseName: string;aPath: String);
procedure ElevateDB_DoGetNames(Query: IDADataset; AList: IROStrings; AObjectType: TDAObjecttype);
procedure ElevateDB_DoGetForeignKeys(Query: IDADataset; ForeignKeys: TDADriverForeignKeyCollection);
procedure ElevateDB_DoGetTableFields(const aTableName: string; Query: IDADataset; out Fields: TDAFieldCollection);
function ElevateDB_GetSPSelectSyntax(HasArguments: Boolean): String;
implementation
uses Classes,SysUtils;
procedure ElevateDB_RegisterDatabase(Query: IDADataset; ADataBaseName: string;aPath: String);
const
s_SQL = 'Select Count(*) from Databases Where name = ''%s''';
s_DropDataBaseSQL = 'DROP DATABASE "%s" KEEP CONTENTS';
s_CreateDataBaseSQL = 'CREATE DATABASE "%s" PATH ''%s''';
begin
try
Query.SQL := Format(s_SQL, [aDataBaseName]);
Query.Open;
if Query.Fields[0].AsInteger =0 then begin
Query.Close;
Query.SQL := Format(s_CreateDataBaseSQL, [aDataBaseName, aPath]);
Query.Execute;
end;
finally
Query := nil;
end;
end;
procedure ElevateDB_DoGetNames(Query: IDADataset; AList: IROStrings; AObjectType: TDAObjecttype);
const
sDoGetTableNames = 'SELECT Name FROM Information.Tables';
sDoGetViewNames = 'SELECT Name FROM Information.Views';
sDoGetProcedures = 'SELECT Name FROM Information.Procedures';
begin
try
case AObjectType of
dotTable: Query.SQL := sDoGetTableNames;
dotView: Query.SQL := sDoGetViewNames;
dotProcedure: Query.SQL := sDoGetProcedures;
end;
Query.Open;
while not Query.Eof do begin
Alist.Add(Query.Fields[0].AsString);
Query.Next;
end;
finally
Query := nil;
end;
end;
procedure ElevateDB_DoGetForeignKeys(Query: IDADataset; ForeignKeys: TDADriverForeignKeyCollection);
const
sFK_SQL = 'Select c.tablename,c.name, c.targettable, cc.columnname '+
'from Information.Constraints as c '+
'join Information.ConstraintColumns as cc on ((c.tablename = cc.tablename) and (cc.constraintname = c.EnforcingIndex)) '+
'where c.type = ''foreign key''';
sPK_SQL = 'Select c.tablename,c.name, c.targettable, cc.columnname '+
'from Information.Constraints as c '+
'join Information.ConstraintColumns as cc on ((c.Targettable = cc.tablename) and (cc.constraintname = c.TargetTableConstraint)) '+
'where c.type = ''foreign key''';
var
lCurrConstraint : string;
lCurrFK : TDADriverForeignKey;
lList: TStringList;
i: integer;
begin
lList:=TstringList.Create;
try
Query.SQL := sFK_SQL;
Query.Open;
lCurrConstraint := '';
lCurrFK := nil;
ForeignKeys.Clear;
while (not Query.EOF) do begin
if lCurrConstraint <> Query.Fields[0].AsString + '.' + Query.Fields[1].AsString then begin
lCurrConstraint := Query.Fields[0].AsString + '.' + Query.Fields[1].AsString;
lCurrFK := ForeignKeys.Add();
lList.AddObject(lCurrConstraint,lCurrFK);
with lCurrFK do begin
Name:=lCurrConstraint;
PKTable := TrimRight(Query.Fields[2].AsString);
FKTable := TrimRight(Query.Fields[0].AsString);
// PKField := TrimRight(Query.Fields[2].AsString);
FKField := TrimRight(Query.Fields[3].AsString);
end;
end else begin
with lCurrFK do begin
// PKField := PKField + ';' + TrimRight(Query.Fields[2].AsString);
FKField := FKField + ';' + TrimRight(Query.Fields[3].AsString);
end;
end;
Query.Next;
end;
Llist.Sorted:=True;
Query.close;
Query.SQL := sPK_SQL;
Query.Open;
while (not Query.EOF) do begin
lCurrConstraint := Query.Fields[0].AsString + '.' + Query.Fields[1].AsString;
i:= lList.IndexOf(lCurrConstraint);
if i <> -1 then begin
lCurrFK:= TDADriverForeignKey(lList.Objects[i]);
if lCurrFK.PKField = '' then
lCurrFK.PKField := TrimRight(Query.Fields[3].AsString)
else
lCurrFK.PKField := lCurrFK.PKField + ';' +TrimRight(Query.Fields[3].AsString);
end;
Query.Next;
end;
finally
Query := nil;
LList.Free;
end;
end;
procedure ElevateDB_DoGetTableFields(const aTableName: string; Query: IDADataset; out Fields: TDAFieldCollection);
const
s_sql = 'SELECT tc.Name, tc.Nullable, tc.Identity, cc.ColumnName, tc.scale FROM Information.TableColumns as tc '+
'LEFT JOIN Information.Constraints AS c ON ((c.TableName = tc.TableName) and (c.Type = ''Primary Key'')) '+
'LEFT JOIN Information.ConstraintColumns as cc on ((c.tablename = cc.tablename) and (cc.constraintname = c.EnforcingIndex) and (cc.ColumnName = tc.Name)) '+
'WHERE tc.TableName = ';
var
fld: TDAField;
begin
Fields := TDAFieldCollection.Create(nil);
try
Query.SQL := 'SELECT * FROM ' + aTableName +' WHERE 1=0';
Query.Open;
Fields.Assign(Query.Fields);
Query.Close;
Query.SQL := s_SQL+ '''' + aTableName+'''';
Query.Open;
While not Query.Eof do begin
fld := Fields.FindField(Trim(Query.Fields[0].AsString));
if Fld <> nil then begin
Fld.Required:=Query.Fields[1].AsBoolean;
if not Query.Fields[2].IsNull and Query.Fields[2].AsBoolean then begin
if fld.DataType = datInteger then fld.DataType := datAutoInc;
if fld.DataType = datLargeInt then fld.DataType := datLargeAutoInc;
end;
if not Query.Fields[3].IsNull then fld.InPrimaryKey:=True;
if fld.DataType = datDecimal then begin
fld.DecimalPrecision:=20;
fld.DecimalScale:=Query.Fields[4].AsInteger;
end;
end;
Query.Next;
end;
finally
Query:=nil;
end;
end;
function ElevateDB_GetSPSelectSyntax(HasArguments: Boolean): String;
begin
if HasArguments then
Result:='CALL {0} ({1})'
else
Result:='CALL {0} ()';
end;
{ TDAElevateDBDriver }
function TDAElevateDBDriver.GetDefaultConnectionType(
const AuxDriver: string): string;
begin
Result:= ElevateDB_DriverType;
end;
{ TDAElevateDBConnection }
procedure TDAElevateDBConnection.CheckConnected;
begin
if not GetConnected then SetConnected(True);
end;
procedure TDAElevateDBConnection.DoGetForeignKeys(
out ForeignKeys: TDADriverForeignKeyCollection);
begin
CheckConnected;
inherited;
ElevateDB_DoGetForeignKeys(GetDatasetClass.Create(Self),ForeignKeys);
end;
procedure TDAElevateDBConnection.DoGetStoredProcedureNames(
out List: IROStrings);
begin
CheckConnected;
inherited;
ElevateDB_DoGetNames(GetDatasetClass.Create(Self),List,dotProcedure);
end;
procedure TDAElevateDBConnection.DoGetTableFields(const aTableName: string;
out Fields: TDAFieldCollection);
begin
CheckConnected;
ElevateDB_DoGetTableFields(QuoteIdentifierIfNeeded(aTableName),GetDatasetClass.Create(Self),Fields);
end;
procedure TDAElevateDBConnection.DoGetTableNames(out List: IROStrings);
begin
CheckConnected;
inherited;
ElevateDB_DoGetNames(GetDatasetClass.Create(Self),List,dotTable);
end;
procedure TDAElevateDBConnection.DoGetViewNames(out List: IROStrings);
begin
CheckConnected;
inherited;
ElevateDB_DoGetNames(GetDatasetClass.Create(Self),List,dotView);
end;
function TDAElevateDBConnection.GetSPSelectSyntax(
HasArguments: Boolean): string;
begin
Result := ElevateDB_GetSPSelectSyntax(HasArguments);
end;
end.