david
2824855ea7
- Recompilación en Delphi10 de todos los paquetes de RO para generar las DCU's en Lib\D10 - Recompilación en Delphi10 de todos los paquetes de DA para generar las DCU's en Lib\D10 git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@9 b6239004-a887-0f4b-9937-50029ccdca16
1528 lines
51 KiB
ObjectPascal
1528 lines
51 KiB
ObjectPascal
unit uDAClasses;
|
|
|
|
{----------------------------------------------------------------------------}
|
|
{ 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
|
|
{$IFDEF MSWINDOWS} Windows,{$ENDIF}
|
|
Classes, SysUtils, uROClasses, uDAInterfaces, uDARes, uROTypes,
|
|
uDADriverManager, uDAXMLUtils, SyncObjs, uROXMLIntf;
|
|
|
|
type
|
|
TDAPoolBehaviour = (pbWait, pbRaiseError, pbIgnoreAndReturn);
|
|
TDAPoolTransactionBehaviour = (ptNone, ptRollback, ptCommit, ptCustom);
|
|
|
|
const
|
|
def_PoolingEnabled = TRUE;
|
|
def_PoolBehaviour = pbWait;
|
|
def_MaxPoolSize = 10;
|
|
def_WaitIntervalSeconds = 1;
|
|
def_PoolTimeoutSeconds = 60;
|
|
|
|
def_SourceTableFieldName = '@SourceTable';
|
|
|
|
type
|
|
{ Forwards }
|
|
TDAConnectionManager = class;
|
|
TDADataDictionary = class;
|
|
|
|
{ TStreamableComponent }
|
|
TPointerArray = array of pointer;
|
|
|
|
TDAStreamableComponent = class(TComponent)
|
|
private
|
|
fTempPropertiesSaved: boolean;
|
|
fTempStorage: TPointerArray;
|
|
|
|
protected
|
|
procedure SaveNonStreamableProperties(var TempStorage: TPointerArray); virtual;
|
|
procedure RestoreNonStreamableProperties(const TempStorage: TPointerArray); virtual;
|
|
|
|
public
|
|
procedure Clear; virtual;
|
|
|
|
procedure LoadFromStream(aStream: TStream; aFormat: TDAPersistFormat=pfXML); virtual;
|
|
procedure LoadFromXml(aXML: string);
|
|
procedure SaveToStream(aStream: TStream; aFormat: TDAPersistFormat=pfXML); virtual;
|
|
procedure LoadFromFile(const aFileName: string; aFormat: TDAPersistFormat=pfXML);
|
|
procedure SaveToFile(const aFileName: string; aFormat: TDAPersistFormat=pfXML);
|
|
end;
|
|
|
|
{ TDAConnectionManager }
|
|
TDAConnectionNotifyEvent = procedure(Sender: TDAConnectionManager; const Connection: IDAConnection) of object;
|
|
TDAConnectionFailureEvent = procedure(Sender: TDAConnectionManager; Ex: Exception) of object;
|
|
TDAConnectionTimeoutEvent = procedure(Sender: TDAConnectionManager) of object;
|
|
TDAUnknownMacroVariableEvent = procedure (Sender: TObject; const Name: string; var Value: string) of object;
|
|
|
|
TDAConnectionManager = class(TDAStreamableComponent, IDAConnectionManager, IDAConnectionPool)
|
|
private
|
|
fConnections: TDAConnectionCollection;
|
|
fDriverManager: TDADriverManager;
|
|
fConnectionWait: TROEvent;
|
|
|
|
fMaxPoolSize: Cardinal;
|
|
fTotalConnections: Integer;
|
|
fConnectionCache: TThreadList;
|
|
fPoolTimeoutSeconds: cardinal;
|
|
fTimer: TROThreadTimer;
|
|
fOnConnectionReleased: TDAConnectionNotifyEvent;
|
|
fOnConnectionTimedOut: TDAConnectionTimeoutEvent;
|
|
fPoolBehaviour: TDAPoolBehaviour;
|
|
fOnConnectionAcquired: TDAConnectionNotifyEvent;
|
|
fWaitIntervalSeconds: cardinal;
|
|
fPoolingEnabled: boolean;
|
|
fOnConnectionCreated: TDAConnectionNotifyEvent;
|
|
FOnConnectionFailure: TDAConnectionFailureEvent;
|
|
fPoolTransactionBehaviour: TDAPoolTransactionBehaviour;
|
|
fOnUnknownMacroVariable: TDAUnknownMacroVariableEvent;
|
|
fOnCustomPoolTransactionBehavior: TDAConnectionNotifyEvent;
|
|
|
|
procedure SetMaxPoolSize(const Value: cardinal);
|
|
procedure SetPoolTimeoutSeconds(const Value: cardinal);
|
|
|
|
procedure SetConnections(const Value: TDAConnectionCollection);
|
|
procedure SetDriverManager(const Value: TDADriverManager);
|
|
procedure SetPoolingEnabled(const Value: boolean);
|
|
function UnknownMacroIdentifier(Sender: TObject; const Name, OrgName: string; var Value: string): Boolean;
|
|
protected
|
|
procedure Loaded; override;
|
|
procedure OnTimerTick(CurrentTickCount: cardinal); dynamic;
|
|
|
|
function CreateNewConnection(const ConnectionName: string;
|
|
OpenConnection: boolean = TRUE;
|
|
const UserID: string = '';
|
|
const Password: string = ''): IDAConnection;
|
|
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|
procedure SaveNonStreamableProperties(var TempStorage: TPointerArray); override;
|
|
procedure RestoreNonStreamableProperties(const TempStorage: TPointerArray); override;
|
|
|
|
procedure ReleaseConnection(const Conn: IDAConnection);
|
|
public
|
|
constructor Create(aOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
|
|
procedure LoadFromStream(aStream: TStream; aFormat: TDAPersistFormat=pfXML); override;
|
|
procedure SaveToStream(aStream: TStream; aFormat: TDAPersistFormat=pfXML); override;
|
|
|
|
// IDAConnectionManager
|
|
function GetDefaultConnectionName: string;
|
|
function NewConnection(const aConnectionName: string;
|
|
OpenConnection: boolean = TRUE;
|
|
const UserID: string = '';
|
|
const Password: string = ''): IDAConnection;
|
|
|
|
procedure Clear; override;
|
|
|
|
property PoolSize: Integer read fTotalConnections;
|
|
procedure ClearPool;
|
|
procedure CheckProperties;
|
|
published
|
|
property MaxPoolSize: cardinal read fMaxPoolSize write SetMaxPoolSize default def_MaxPoolSize;
|
|
property PoolTimeoutSeconds: cardinal read fPoolTimeoutSeconds write SetPoolTimeoutSeconds default def_PoolTimeoutSeconds;
|
|
property PoolBehaviour: TDAPoolBehaviour read fPoolBehaviour write fPoolBehaviour default def_PoolBehaviour;
|
|
|
|
property OnConnectionAcquired: TDAConnectionNotifyEvent read fOnConnectionAcquired write fOnConnectionAcquired;
|
|
property OnConnectionTimedOut: TDAConnectionTimeoutEvent read fOnConnectionTimedOut write fOnConnectionTimedOut;
|
|
property OnConnectionCreated: TDAConnectionNotifyEvent read fOnConnectionCreated write fOnConnectionCreated;
|
|
property OnConnectionFailure: TDAConnectionFailureEvent read FOnConnectionFailure write FOnConnectionFailure;
|
|
property OnConnectionReleased: TDAConnectionNotifyEvent read fOnConnectionReleased write fOnConnectionReleased;
|
|
property OnCustomPoolTransactionBehavior: TDAConnectionNotifyEvent read fOnCustomPoolTransactionBehavior write fOnCustomPoolTransactionBehavior;
|
|
property OnUnknownMacroVariable: TDAUnknownMacroVariableEvent read fOnUnknownMacroVariable write fOnUnknownMacroVariable;
|
|
|
|
property WaitIntervalSeconds: cardinal read fWaitIntervalSeconds write fWaitIntervalSeconds default def_WaitIntervalSeconds;
|
|
|
|
property Connections: TDAConnectionCollection read fConnections write SetConnections;
|
|
property DriverManager: TDADriverManager read fDriverManager write SetDriverManager;
|
|
|
|
property PoolingEnabled: boolean read fPoolingEnabled write SetPoolingEnabled;
|
|
property PoolTransactionBehaviour: TDAPoolTransactionBehaviour read fPoolTransactionBehaviour write fPoolTransactionBehaviour default ptNone;
|
|
end;
|
|
|
|
{ TDADataDictionary }
|
|
TDADataDictionary = class(TDAStreamableComponent, IDADataDictionary)
|
|
private
|
|
fFields: TDADataDictionaryFieldCollection;
|
|
procedure SetFields(const Value: TDADataDictionaryFieldCollection);
|
|
function GetFields: TDADataDictionaryFieldCollection;
|
|
protected
|
|
procedure SaveNonStreamableProperties(var TempStorage: TPointerArray); override;
|
|
procedure RestoreNonStreamableProperties(const TempStorage: TPointerArray); override;
|
|
public
|
|
constructor Create(aOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
published
|
|
property Fields: TDADataDictionaryFieldCollection read GetFields write SetFields;
|
|
end;
|
|
|
|
TDADiagrams = class(TComponent)
|
|
private
|
|
fDiagramData: string;
|
|
procedure ReadDiagramData(Reader: TReader);
|
|
procedure WriteDiagramData(Writer: TWriter);
|
|
protected
|
|
procedure DefineProperties(Filer: TFiler); override;
|
|
public
|
|
procedure LoadFromFile(const aFilename: string);
|
|
procedure SaveToFile(const aFilename: string);
|
|
end;
|
|
|
|
{ TDASchema }
|
|
TDASchema = class;
|
|
|
|
TDASchemaElementType = (setDataset, setCommand);
|
|
TDAOnGetSQLEvent = procedure(Sender : TDASchema; const ElementName : string; ElementType : TDASchemaElementType; var SQL : string) of object;
|
|
|
|
TDASchema = class(TDAStreamableComponent, IDASchema, IDAHasDataDictionary)
|
|
private
|
|
fDatasets: TDADatasetCollection;
|
|
fJoinDataTables: TDAJoinDataTableCollection;
|
|
fUnionDataTables: TDAUnionDataTableCollection;
|
|
fCommands: TDASQLCommandCollection;
|
|
fConnectionManager: TDAConnectionManager;
|
|
fDataDictionary: TDADataDictionary;
|
|
fOnGetSQL: TDAOnGetSQLEvent;
|
|
fUpdateRules: TDAUpdateRuleCollection;
|
|
fRelationShips: TDADatasetRelationshipCollection;
|
|
fDiagrams: TDADiagrams;
|
|
fCustomAttributes: TStrings;
|
|
fVersion: Integer;
|
|
fMergeDataDictionaries: Boolean;
|
|
|
|
procedure SetConnectionManager(const Value: TDAConnectionManager);
|
|
procedure SetDataDictionary(const Value: TDADataDictionary);
|
|
procedure SetUpdateRules(const Value: TDAUpdateRuleCollection);
|
|
procedure SetRelationShips(const Value: TDADatasetRelationshipCollection);
|
|
procedure SetDiagrams(const Value: TDADiagrams);
|
|
|
|
protected
|
|
function GetDataDictionary: IDADataDictionary;
|
|
function MergeDataDictionaries: Boolean;
|
|
function GetCommands: TDASQLCommandCollection; virtual;
|
|
function GetDatasets: TDADatasetCollection; virtual;
|
|
function GetJoinDataTables: TDAJoinDataTableCollection; virtual;
|
|
function GetUnionDataTables: TDAUnionDataTableCollection; virtual;
|
|
procedure SetCommands(const Value: TDASQLCommandCollection); virtual;
|
|
procedure SetDatasets(const Value: TDADatasetCollection); virtual;
|
|
procedure SetJoinDataTables(const Value: TDAJoinDataTableCollection); virtual;
|
|
procedure SetUnionDataTables(const Value: TDAUnionDataTableCollection); virtual;
|
|
|
|
procedure Notification(aComponent: TComponent; Operation: TOperation); override;
|
|
procedure Loaded; override;
|
|
|
|
procedure SaveNonStreamableProperties(var TempStorage: TPointerArray); override;
|
|
procedure RestoreNonStreamableProperties(const TempStorage: TPointerArray); override;
|
|
|
|
public
|
|
constructor Create(aOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
|
|
function FindCommandStatement(const aConnection: IDAConnection; aSQLCommand: TDASQLCommand; aStatementName: string=''): TDAStatement;
|
|
// IDASchema
|
|
function GetDatasetText(const aConnection: IDAConnection; const aName: string): string; virtual;
|
|
function GetCommandText(const aConnection: IDAConnection; const aName: string): string; virtual;
|
|
|
|
function NewDataset(const aConnection: IDAConnection; const aName: string;
|
|
aStatementName: string='';OpenIt: boolean = false): IDADataset; overload; virtual;
|
|
function NewDataset(const aConnection: IDAConnection; const aName: string;
|
|
const ParamNames: array of string;
|
|
const ParamValues: array of Variant;
|
|
OpenIt: boolean = TRUE;
|
|
aStatementName: string=''): IDADataset; overload;
|
|
function NewDataset(const aConnection: IDAConnection; const aName: string;
|
|
aDynSelectFields: array of string;
|
|
aWhereClause: WideString;
|
|
aStatementName: string='';
|
|
OpenIt: boolean = false; AlwaysGenerateDynamicWhereStatement: Boolean=False): IDADataset; overload;
|
|
function NewDataset(const aConnection: IDAConnection; const aName: string;
|
|
const ParamNames: array of string;
|
|
const ParamValues: array of Variant;
|
|
aDynSelectFields: array of string;
|
|
aWhereClause: WideString;
|
|
OpenIt: boolean = TRUE;
|
|
aStatementName: string=''): IDADataset; overload;
|
|
|
|
|
|
|
|
function NewCommand(const aConnection: IDAConnection; const aName: string;
|
|
aStatementName: string=''): IDASQLCommand; overload; virtual;
|
|
function NewCommand(const aConnection: IDAConnection; const aName: string;
|
|
const ParamNames: array of string;
|
|
const ParamValues: array of Variant;
|
|
ExecuteIt: boolean = TRUE; aStatementName: string=''): IDASQLCommand; overload;
|
|
|
|
procedure Clear; override;
|
|
|
|
procedure Copy(aSourceSchema : TDASchema;
|
|
DatasetNames : array of string;
|
|
CommandNames : array of string;
|
|
UpdateRuleNames : array of string;
|
|
RelationShipNames : array of string); overload;
|
|
|
|
procedure Copy(aSourceSchema : TDASchema;
|
|
IncludeDatasets : boolean = TRUE;
|
|
IncludeCommands : boolean = TRUE;
|
|
IncludeUpdateRules : boolean = TRUE;
|
|
IncludeRelationShips : boolean = TRUE); overload;
|
|
procedure CheckProperties;
|
|
function FindDataset(aDatasetName: String): TDADataset;
|
|
procedure SaveToStream(aStream: TStream;
|
|
aFormat: TDAPersistFormat = pfXML); override;
|
|
published
|
|
property ConnectionManager: TDAConnectionManager read fConnectionManager write SetConnectionManager;
|
|
property DataDictionary: TDADataDictionary read fDataDictionary write SetDataDictionary;
|
|
property Diagrams: TDADiagrams read fDiagrams write SetDiagrams;
|
|
property Datasets: TDADatasetCollection read GetDatasets write SetDatasets;
|
|
property JoinDataTables: TDAJoinDataTableCollection read GetJoinDataTables write SetJoinDataTables;
|
|
property UnionDataTables: TDAUnionDataTableCollection read GetUnionDataTables write SetUnionDataTables;
|
|
property Commands: TDASQLCommandCollection read GetCommands write SetCommands;
|
|
property RelationShips: TDADatasetRelationshipCollection read fRelationShips write SetRelationShips;
|
|
property UpdateRules : TDAUpdateRuleCollection read fUpdateRules write SetUpdateRules;
|
|
|
|
property OnGetSQL : TDAOnGetSQLEvent read fOnGetSQL write fOnGetSQL;
|
|
property Version : Integer read fVersion write fVersion;
|
|
property CustomAttributes : TStrings read fCustomAttributes;
|
|
end;
|
|
|
|
procedure FillROStruct(const aDataset: IDADataset; const aStruct: TROComplexType);
|
|
|
|
implementation
|
|
|
|
uses TypInfo, uDAEngine, uDAUtils, DB, uDAMemDataTable, uDAWhere;
|
|
|
|
procedure FillROStruct(const aDataset: IDADataset; const aStruct: TROComplexType);
|
|
var
|
|
proplist: TStringList;
|
|
i: integer;
|
|
fld: TDACustomField;
|
|
begin
|
|
proplist := TStringList.Create;
|
|
try
|
|
aStruct.GetFieldNames(proplist);
|
|
for i := 0 to (proplist.Count - 1) do begin
|
|
fld := aDataset.Fields.FindField(proplist[i]);
|
|
if (fld <> nil) then aStruct.SetFieldValue(proplist[i], fld.Value);
|
|
end;
|
|
finally
|
|
proplist.Free;
|
|
end;
|
|
end;
|
|
|
|
{ TDAStreamableComponent }
|
|
|
|
procedure TDAStreamableComponent.LoadFromStream(aStream: TStream; aFormat: TDAPersistFormat);
|
|
var
|
|
oldname: string;
|
|
begin
|
|
Clear;
|
|
|
|
oldname := Name;
|
|
try Name := ''; except end;
|
|
try
|
|
case aFormat of
|
|
pfBinary: aStream.ReadComponent(Self);
|
|
pfXML: LoadObjectFromStream(aStream, Self, ['Name']);
|
|
end;
|
|
|
|
if fTempPropertiesSaved then begin
|
|
RestoreNonStreamableProperties(fTempStorage);
|
|
SetLength(fTempStorage, 0);
|
|
end;
|
|
finally
|
|
fTempPropertiesSaved := FALSE;
|
|
try Name := oldname; except end;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAStreamableComponent.LoadFromXml(aXML: string);
|
|
var lStream:TStringStream;
|
|
begin
|
|
lStream := TStringStream.Create(aXML);
|
|
try
|
|
lStream.Seek(0,soFromBeginning);
|
|
LoadFromStream(lStream,pfXML);
|
|
finally
|
|
lStream.Free();
|
|
end;
|
|
end;
|
|
|
|
procedure TDAStreamableComponent.SaveToStream(aStream: TStream; aFormat: TDAPersistFormat);
|
|
var
|
|
oldname: string;
|
|
begin
|
|
fTempPropertiesSaved := TRUE;
|
|
|
|
oldname := Name;
|
|
//Name := '';
|
|
try
|
|
try
|
|
SaveNonStreamableProperties(fTempStorage);
|
|
|
|
case aFormat of
|
|
pfBinary: aStream.WriteComponent(Self);
|
|
pfXML: SaveObjectToStream(Self, aStream, ['Name']);
|
|
end;
|
|
finally
|
|
Name := oldname;
|
|
end;
|
|
except
|
|
fTempPropertiesSaved := FALSE;
|
|
raise;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAStreamableComponent.SaveToFile(const aFileName: string;
|
|
aFormat: TDAPersistFormat);
|
|
var
|
|
fs: TFileStream;
|
|
begin
|
|
fs := TFileStream.Create(aFileName, fmCreate);
|
|
try
|
|
SaveToStream(fs, aFormat);
|
|
finally
|
|
fs.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAStreamableComponent.LoadFromFile(const aFileName: string;
|
|
aFormat: TDAPersistFormat);
|
|
var
|
|
fs: TFileStream;
|
|
begin
|
|
fs := TFileStream.Create(aFileName, fmOpenRead);
|
|
try
|
|
LoadFromStream(fs, aFormat);
|
|
finally
|
|
fs.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAStreamableComponent.RestoreNonStreamableProperties(
|
|
const TempStorage: TPointerArray);
|
|
begin
|
|
end;
|
|
|
|
procedure TDAStreamableComponent.SaveNonStreamableProperties(
|
|
var TempStorage: TPointerArray);
|
|
begin
|
|
|
|
end;
|
|
|
|
procedure TDAStreamableComponent.Clear;
|
|
begin
|
|
end;
|
|
|
|
type
|
|
TCachedConnection = class
|
|
private
|
|
fConnection: IDAConnection;
|
|
fLastUse: TDateTime;
|
|
public
|
|
constructor Create(const aConnection: IDAConnection);
|
|
property Connection: IDAConnection read fConnection write fConnection;
|
|
property LastUse: TDateTime read fLastUse write fLastUse;
|
|
end;
|
|
|
|
constructor TCachedConnection.Create(const aConnection: IDAConnection);
|
|
begin
|
|
inherited Create;
|
|
fConnection := aConnection;
|
|
fLastUse := Now;
|
|
end;
|
|
|
|
{ TDAConnectionManager }
|
|
|
|
constructor TDAConnectionManager.Create(aOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
fConnectionWait := TROEvent.Create(nil, false, false, '');
|
|
|
|
fConnections := TDAConnectionCollection.Create(Self);
|
|
|
|
fPoolingEnabled := def_PoolingEnabled;
|
|
fPoolBehaviour := def_PoolBehaviour;
|
|
fMaxPoolSize := def_MaxPoolSize;
|
|
fWaitIntervalSeconds := def_WaitIntervalSeconds;
|
|
fPoolTimeoutSeconds := def_PoolTimeoutSeconds;
|
|
|
|
fConnectionCache := TThreadList.Create;
|
|
end;
|
|
|
|
destructor TDAConnectionManager.Destroy;
|
|
begin
|
|
DriverManager := nil;
|
|
|
|
fConnections.Free;
|
|
ClearPool;
|
|
fConnectionCache.Free;
|
|
|
|
fTimer.Free;
|
|
fConnectionWait.Free;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TDAConnectionManager.SetConnections(const Value: TDAConnectionCollection);
|
|
begin
|
|
fConnections.Assign(Value);
|
|
end;
|
|
|
|
function TDAConnectionManager.CreateNewConnection(const ConnectionName: string;
|
|
OpenConnection: boolean = TRUE;
|
|
const UserID: string = '';
|
|
const Password: string = ''): IDAConnection;
|
|
var
|
|
conndef: TDAConnection;
|
|
drv: IDADriver;
|
|
mac: IDAHasMacroProcessor;
|
|
drvid: string;
|
|
begin
|
|
CheckProperties;
|
|
|
|
conndef := Connections.ItemByName(ConnectionName) as TDAConnection; // Raises exception if not found
|
|
drvid := TDAConnectionStringParser.ExtractDriverID(conndef.ConnectionString);
|
|
|
|
drv := fDriverManager.DriverByDriverID(drvid); // Raises exception if not found
|
|
result := drv.NewConnection(self, conndef);
|
|
|
|
// If not empty strings, these will override any specific UserID, Password specified below
|
|
result.ConnectionString := conndef.ConnectionString;
|
|
|
|
if (UserID <> '') then result.UserID := UserID;
|
|
if (Password <> '') then result.Password := Password;
|
|
|
|
if OpenConnection then result.Open;
|
|
|
|
if Assigned(fOnConnectionCreated) then fOnConnectionCreated(Self, result);
|
|
if Supports(Result, IDAHasMacroProcessor, mac) and (mac.GetMacroProcessor <> nil) then begin
|
|
mac.GetMacroProcessor.OnUnknownIdentifier := UnknownMacroIdentifier;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAConnectionManager.SetDriverManager(const Value: TDADriverManager);
|
|
begin
|
|
fDriverManager := Value;
|
|
ClearPool();
|
|
if (fDriverManager <> nil) then fDriverManager.FreeNotification(Self);
|
|
end;
|
|
|
|
procedure TDAConnectionManager.Notification(AComponent: TComponent;
|
|
Operation: TOperation);
|
|
begin
|
|
inherited;
|
|
|
|
if (Operation <> opRemove) then Exit;
|
|
if (AComponent = fDriverManager) then DriverManager := nil;
|
|
end;
|
|
|
|
procedure TDAConnectionManager.RestoreNonStreamableProperties(
|
|
const TempStorage: TPointerArray);
|
|
begin
|
|
DriverManager := TempStorage[0];
|
|
end;
|
|
|
|
procedure TDAConnectionManager.SaveNonStreamableProperties(
|
|
var TempStorage: TPointerArray);
|
|
begin
|
|
SetLength(TempStorage, 1);
|
|
TempStorage[0] := DriverManager;
|
|
end;
|
|
|
|
function TDAConnectionManager.GetDefaultConnectionName: string;
|
|
var
|
|
i: integer;
|
|
begin
|
|
result := '';
|
|
for i := 0 to (fConnections.Count - 1) do
|
|
if Connections[i].Default then begin
|
|
result := Connections[i].Name;
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAConnectionManager.Clear;
|
|
begin
|
|
fConnections.Clear;
|
|
end;
|
|
|
|
procedure TDAConnectionManager.SetMaxPoolSize(const Value: cardinal);
|
|
begin
|
|
fMaxPoolSize := Value;
|
|
end;
|
|
|
|
procedure TDAConnectionManager.SetPoolTimeoutSeconds(const Value: cardinal);
|
|
begin
|
|
if (fPoolTimeoutSeconds = Value) and (fTimer <> nil) then Exit;
|
|
fPoolTimeoutSeconds := Value;
|
|
|
|
if not (csDesigning in ComponentState) then begin
|
|
if (PoolSize > 0) then RaiseError(err_PoolIsNotEmpty);
|
|
|
|
if Assigned(fTimer) then begin
|
|
fTimer.Free;
|
|
fTimer := nil;
|
|
end;
|
|
|
|
if (fPoolTimeoutSeconds > 0) then fTimer := TROThreadTimer.Create(OnTimerTick, fPoolTimeoutSeconds * 500);
|
|
end;
|
|
end;
|
|
|
|
procedure TDAConnectionManager.OnTimerTick(CurrentTickCount: cardinal);
|
|
var
|
|
i: integer;
|
|
tempconn: TCachedConnection;
|
|
list: TList;
|
|
begin
|
|
list := fConnectionCache.LockList;
|
|
try
|
|
for i := list.Count - 1 downto 0 do
|
|
begin
|
|
tempconn := TCachedConnection(list[i]);
|
|
if tempconn.LastUse + (fPoolTimeoutSeconds / 86400.0) < Now then begin
|
|
if Assigned(fOnConnectionTimedOut) then fOnConnectionTimedOut(Self);
|
|
list.Delete(i);
|
|
tempconn.Connection.ConnectionPool := nil;
|
|
tempconn.Free;
|
|
dec(fTotalConnections);
|
|
end;
|
|
end;
|
|
finally
|
|
fConnectionCache.UnlockList;
|
|
end;
|
|
end;
|
|
|
|
function TDAConnectionManager.NewConnection(const aConnectionName: string;
|
|
OpenConnection: boolean = TRUE; const UserID: string = ''; const Password: string = ''): IDAConnection;
|
|
var
|
|
i: integer;
|
|
conn: TDAConnection;
|
|
list: TList;
|
|
tempconn: TCachedConnection;
|
|
begin
|
|
try
|
|
// If pooling is not enable immediately creates a connection.
|
|
// This is the quickest way to Acquire one
|
|
if not fPoolingEnabled then begin
|
|
result := CreateNewConnection(aConnectionName, OpenConnection, UserID, Password);
|
|
if Assigned(fOnConnectionAcquired) then fOnConnectionAcquired(Self, result);
|
|
Exit;
|
|
end;
|
|
|
|
// Pooling is enabled and has to be thread safe
|
|
result := nil;
|
|
conn := fConnections.ConnectionByName(aConnectionName);
|
|
while true do begin
|
|
list := fConnectionCache.LockList;
|
|
try
|
|
for i := list.Count -1 downto 0 do begin
|
|
tempconn := TCachedConnection(list[i]);
|
|
if not tempconn.Connection.IsAlive then begin
|
|
tempconn.Connection:=nil;
|
|
list.Delete(i);
|
|
end;
|
|
end;
|
|
for i := 0 to list.Count -1 do begin
|
|
tempconn := TCachedConnection(list[i]);
|
|
|
|
if SameText(tempconn.Connection.ConnectionString, conn.ConnectionString) and
|
|
SameText(tempconn.Connection.ConnectionType, conn.ConnectionType) then begin
|
|
list.Delete(i);
|
|
Result := tempconn.Connection;
|
|
tempconn.Free;
|
|
if Assigned(fOnConnectionAcquired) then fOnConnectionAcquired(Self, result);
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
// If it doesn't find one and the max poolsize is not reached then creates it...
|
|
if Cardinal(fTotalConnections) < fMaxPoolSize then begin
|
|
result := CreateNewConnection(aConnectionName, OpenConnection, UserID, Password);
|
|
result.ConnectionPool := self;
|
|
inc(fTotalConnections);
|
|
if Assigned(fOnConnectionAcquired) then fOnConnectionAcquired(Self, result);
|
|
Exit;
|
|
end;
|
|
|
|
finally
|
|
fConnectionCache.UnlockList;
|
|
end;
|
|
// Otherwise either waits and tries again or raises an error
|
|
case PoolBehaviour of
|
|
pbRaiseError: RaiseError(err_MaxPoolSizeReached);
|
|
pbWait: begin
|
|
if fConnectionWait.WaitFor(1000 * fWaitIntervalSeconds) <> wrSignaled then
|
|
RaiseError(err_MaxPoolSizeReached);
|
|
end;
|
|
pbIgnoreAndReturn: Exit;
|
|
end;
|
|
end;
|
|
except
|
|
on e: Exception do begin
|
|
if assigned(FOnConnectionFailure) then FOnConnectionFailure(self, E);
|
|
raise;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAConnectionManager.ReleaseConnection(const Conn: IDAConnection);
|
|
var
|
|
list: TList;
|
|
begin
|
|
case fPoolTransactionBehaviour of
|
|
ptRollback: if Conn.InTransaction then Conn.RollbackTransaction;
|
|
ptCommit: if Conn.InTransaction then Conn.CommitTransaction;
|
|
ptCustom: if Conn.InTransaction and assigned(fOnCustomPoolTransactionBehavior) then
|
|
fOnCustomPoolTransactionBehavior(Self, Conn);
|
|
end;
|
|
if assigned(fOnConnectionReleased) then
|
|
fOnConnectionReleased(Self, Conn);
|
|
if fPoolingEnabled then begin
|
|
list := fConnectionCache.LockList;
|
|
try
|
|
if (Cardinal(list.Count) < fMaxPoolSize) and Conn.isAlive then begin
|
|
fConnectionCache.Add(TCachedConnection.Create(Conn))
|
|
end else
|
|
Dec(fTotalConnections);
|
|
finally
|
|
fConnectionCache.UnlockList;
|
|
end;
|
|
fConnectionWait.SetEvent;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAConnectionManager.SetPoolingEnabled(const Value: boolean);
|
|
begin
|
|
fPoolingEnabled := Value;
|
|
end;
|
|
|
|
procedure TDAConnectionManager.ClearPool;
|
|
var
|
|
i: Integer;
|
|
list: TList;
|
|
begin
|
|
list := fConnectionCache.LockList;
|
|
try
|
|
for i := list.Count -1 downto 0 do begin
|
|
TCachedConnection(List[i]).Connection.ConnectionPool := nil;
|
|
TCachedConnection(List[i]).Free;
|
|
end;
|
|
Dec(fTotalConnections, list.Count);
|
|
list.Clear;
|
|
finally
|
|
fConnectionCache.UnlockList;
|
|
end;
|
|
end;
|
|
|
|
const
|
|
nn_Connections = 'Connections';
|
|
nn_Definitions = 'Definitions';
|
|
nn_Definition = 'Definition';
|
|
|
|
nn_PoolingEnabled = 'PoolingEnabled';
|
|
nn_PoolingBehavior = 'PoolingBehavior';
|
|
nn_MaxPoolSize = 'MaxPoolSize';
|
|
nn_WaitIntervalSeconds = 'WaitIntervalSeconds';
|
|
nn_PoolTimeoutSeconds = 'PoolTimeoutSeconds';
|
|
|
|
nn_ConnectionString = 'ConnectionString';
|
|
nn_Default = 'Default';
|
|
nn_Name = 'Name';
|
|
nn_Description = 'Description';
|
|
nn_ConnectionType = 'ConnectionType';
|
|
|
|
procedure TDAConnectionManager.LoadFromStream(aStream: TStream;
|
|
aFormat: TDAPersistFormat);
|
|
var buff: array[0..21] of char;
|
|
xmlDoc: IXMLDocument;
|
|
s: string;
|
|
i : integer;
|
|
connsNode, thisNode: IXMLNode;
|
|
conn: TDAConnection;
|
|
begin
|
|
aStream.Position := 0;
|
|
aStream.ReadBuffer(buff, SizeOf(buff));
|
|
if (buff<>'<TDAConnectionManager>') then begin
|
|
aStream.Position := 0;
|
|
xmlDoc := NewROXmlDocument;
|
|
xmlDoc.New();
|
|
xmlDoc.LoadFromStream(aStream);
|
|
|
|
Clear;
|
|
|
|
PoolingEnabled := xmlDoc.DocumentNode.GetNodeValue(nn_PoolingEnabled, def_PoolingEnabled);
|
|
// TDAPoolBehaviour = (pbWait, pbRaiseError, pbIgnoreAndReturn);
|
|
s := xmlDoc.DocumentNode.GetNodeValue(nn_PoolingBehavior, GetEnumName(TypeInfo(TDAPoolBehaviour), Ord(def_PoolBehaviour)));
|
|
if (Pos('pb', s)<>1) then s := 'pb'+s;
|
|
PoolBehaviour := TDAPoolBehaviour(GetEnumValue(TypeInfo(TDAPoolBehaviour), s));
|
|
MaxPoolSize := xmlDoc.DocumentNode.GetNodeValue(nn_MaxPoolSize, def_MaxPoolSize);
|
|
WaitIntervalSeconds := xmlDoc.DocumentNode.GetNodeValue(nn_WaitIntervalSeconds, def_WaitIntervalSeconds);
|
|
PoolTimeoutSeconds := xmlDoc.DocumentNode.GetNodeValue(nn_PoolTimeoutSeconds, def_PoolTimeoutSeconds);
|
|
|
|
connsNode := xmlDoc.DocumentNode.GetNodeByName(nn_Definitions);
|
|
if (connsNode=NIL) then Exit;
|
|
for i := 0 to (connsNode.ChildrenCount-1) do begin
|
|
thisNode := connsNode.Children[i];
|
|
if thisNode.Name <> nn_Definition then continue;
|
|
|
|
conn := Connections.Add;
|
|
conn.Name := thisNode.GetNodeValue(nn_Name, 'Connection'+IntToStr(i+1));
|
|
conn.Description:= thisNode.GetNodeValue(nn_Description, '');
|
|
conn.Default := thisNode.GetNodeValue(nn_Default, FALSE);
|
|
conn.ConnectionString := thisNode.GetNodeValue(nn_ConnectionString, '');
|
|
conn.ConnectiontYPE := thisNode.GetNodeValue(nn_ConnectionType, '');
|
|
end;
|
|
end
|
|
else inherited;
|
|
end;
|
|
|
|
procedure TDAConnectionManager.SaveToStream(aStream: TStream;
|
|
aFormat: TDAPersistFormat);
|
|
var xmlDoc : IXMLDocument;
|
|
connNode, thisNode: IXMLNode;
|
|
s: string;
|
|
i: integer;
|
|
begin
|
|
if (aFormat=pfBinary) then begin
|
|
inherited;
|
|
Exit;
|
|
end;
|
|
|
|
xmlDoc := NewROXmlDocument;
|
|
xmlDoc.New(nn_Connections);
|
|
thisNode := xmlDoc.DocumentNode;
|
|
|
|
thisnode.Add(nn_PoolingEnabled).Value := PoolingEnabled;
|
|
s := GetEnumName(TypeInfo(TDAPoolBehaviour), Ord(PoolBehaviour));
|
|
thisnode.Add(nn_PoolingBehavior).Value := Copy(s, 3, MaxInt);
|
|
thisnode.Add(nn_MaxPoolSize).Value := MaxPoolSize;
|
|
thisnode.Add(nn_WaitIntervalSeconds).Value := WaitIntervalSeconds;
|
|
thisnode.Add(nn_PoolTimeoutSeconds).Value := PoolTimeoutSeconds;
|
|
|
|
connNode := thisNode.Add(nn_Definitions);
|
|
for i := 0 to (Connections.Count-1) do begin
|
|
thisNode := connNode.Add(nn_Definition);
|
|
thisNode.Add(nn_Name).Value := Connections[i].Name;
|
|
thisNode.Add(nn_ConnectionString).Value := Connections[i].ConnectionString;
|
|
thisNode.Add(nn_Default).Value := Connections[i].Default;
|
|
thisNode.Add(nn_Description).Value := Connections[i].Description;
|
|
thisNode.Add(nn_ConnectionType).Value := Connections[i].ConnectionType;
|
|
end;
|
|
|
|
xmlDoc.SaveToStream(aStream);
|
|
end;
|
|
|
|
procedure TDAConnectionManager.Loaded;
|
|
begin
|
|
inherited;
|
|
if not (csDesigning in ComponentState) then
|
|
begin
|
|
SetPoolTimeoutSeconds(fPoolTimeoutSeconds);
|
|
end;
|
|
end;
|
|
|
|
function TDAConnectionManager.UnknownMacroIdentifier(Sender: TObject;
|
|
const Name, OrgName: string; var Value: string): Boolean;
|
|
begin
|
|
Value := Name;
|
|
result := TRUE;
|
|
if assigned(fOnUnknownMacroVariable) then begin
|
|
fOnUnknownMacroVariable(Self, OrgName, Value);
|
|
end;
|
|
end;
|
|
|
|
procedure TDAConnectionManager.CheckProperties;
|
|
begin
|
|
Check(not Assigned(DriverManager), Name + '. '+err_DriverManagerNotAssigned);
|
|
end;
|
|
|
|
{ TDADataDictionary }
|
|
|
|
constructor TDADataDictionary.Create(aOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
fFields := TDADataDictionaryFieldCollection.Create(self, TDADataDictionaryField);
|
|
end;
|
|
|
|
destructor TDADataDictionary.Destroy;
|
|
begin
|
|
fFields.Free;
|
|
inherited;
|
|
end;
|
|
|
|
function TDADataDictionary.GetFields: TDADataDictionaryFieldCollection;
|
|
begin
|
|
result := fFields;
|
|
end;
|
|
|
|
procedure TDADataDictionary.RestoreNonStreamableProperties(const TempStorage: TPointerArray);
|
|
begin
|
|
|
|
end;
|
|
|
|
procedure TDADataDictionary.SaveNonStreamableProperties(var TempStorage: TPointerArray);
|
|
begin
|
|
|
|
end;
|
|
|
|
procedure TDADataDictionary.SetFields(const Value: TDADataDictionaryFieldCollection);
|
|
begin
|
|
fFields.Assign(Value);
|
|
end;
|
|
|
|
{ TDASchema }
|
|
|
|
constructor TDASchema.Create(aOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
fCustomAttributes := TStringList.Create;
|
|
fDatasets := TDADatasetCollection.Create(Self);
|
|
fJoinDataTables := TDAJoinDataTableCollection.Create(Self);
|
|
fUnionDataTables := TDAUnionDataTableCollection.Create(Self);
|
|
fCommands := TDASQLCommandCollection.Create(Self);
|
|
fRelationShips := TDADatasetRelationshipCollection.Create(Self);
|
|
fUpdateRules := TDAUpdateRuleCollection.Create(Self);
|
|
end;
|
|
|
|
destructor TDASchema.Destroy;
|
|
begin
|
|
FreeAndNil(fDatasets);
|
|
FreeAndNil(fJoinDataTables);
|
|
FreeAndNil(fUnionDataTables);
|
|
FreeAndNil(fCommands);
|
|
FreeAndNil(fRelationShips);
|
|
FreeAndNil(fUpdateRules);
|
|
fCustomAttributes.Free;
|
|
|
|
inherited;
|
|
end;
|
|
|
|
procedure TDASchema.Notification(aComponent: TComponent; Operation: TOperation);
|
|
begin
|
|
inherited;
|
|
if (Operation <> opRemove) then Exit;
|
|
if aComponent = ConnectionManager then
|
|
ConnectionManager := nil
|
|
else if aComponent = DataDictionary then
|
|
DataDictionary := nil
|
|
else if aComponent = Diagrams then
|
|
Diagrams := nil;
|
|
end;
|
|
|
|
function TDASchema.GetCommands: TDASQLCommandCollection;
|
|
begin
|
|
Result := fCommands;
|
|
end;
|
|
|
|
function TDASchema.GetDatasets: TDADatasetCollection;
|
|
begin
|
|
Result := fDatasets;
|
|
end;
|
|
|
|
function TDASchema.GetJoinDataTables: TDAJoinDataTableCollection;
|
|
begin
|
|
Result := fJoinDataTables;
|
|
end;
|
|
|
|
function TDASchema.GetUnionDataTables: TDAUnionDataTableCollection;
|
|
begin
|
|
Result := fUnionDataTables;
|
|
end;
|
|
|
|
procedure TDASchema.SetCommands(const Value: TDASQLCommandCollection);
|
|
begin
|
|
fCommands.Assign(Value);
|
|
end;
|
|
|
|
procedure TDASchema.SetDatasets(const Value: TDADatasetCollection);
|
|
begin
|
|
fDatasets.Assign(Value);
|
|
end;
|
|
|
|
procedure TDASchema.SetJoinDataTables(const Value: TDAJoinDataTableCollection);
|
|
begin
|
|
fJoinDataTables.Assign(Value);
|
|
end;
|
|
|
|
procedure TDASchema.SetUnionDataTables(const Value: TDAUnionDataTableCollection);
|
|
begin
|
|
fUnionDataTables.Assign(Value);
|
|
end;
|
|
|
|
procedure TDASchema.Loaded;
|
|
begin
|
|
inherited;
|
|
end;
|
|
|
|
procedure TDASchema.SetConnectionManager(const Value: TDAConnectionManager);
|
|
begin
|
|
if fConnectionManager <> Value then begin
|
|
fConnectionManager := Value;
|
|
if (fConnectionManager <> nil) then fConnectionManager.FreeNotification(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TDASchema.SetDataDictionary(const Value: TDADataDictionary);
|
|
begin
|
|
if fDataDictionary <> Value then begin
|
|
fDataDictionary := Value;
|
|
if (fDataDictionary <> nil) then fDataDictionary.FreeNotification(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TDASchema.RestoreNonStreamableProperties(
|
|
const TempStorage: TPointerArray);
|
|
begin
|
|
fConnectionManager := TempStorage[0];
|
|
fDataDictionary := TempStorage[1];
|
|
end;
|
|
|
|
procedure TDASchema.SaveNonStreamableProperties(
|
|
var TempStorage: TPointerArray);
|
|
begin
|
|
SetLength(TempStorage, 2);
|
|
TempStorage[0] := fConnectionManager;
|
|
TempStorage[1] := fDataDictionary;
|
|
end;
|
|
|
|
function TDASchema.GetCommandText(const aConnection: IDAConnection; const aName: string): string;
|
|
var
|
|
cmd: TDASQLCommand;
|
|
begin
|
|
cmd := TDASQLCommand(Commands.ItemByName(aName));
|
|
result := FindCommandStatement(aConnection, cmd).SQL;
|
|
end;
|
|
|
|
function TDASchema.GetDatasetText(const aConnection: IDAConnection; const aName: string): string;
|
|
var
|
|
ds: TDADataset;
|
|
begin
|
|
ds := TDADataset(Datasets.ItemByName(aName));
|
|
result := FindCommandStatement(aConnection, ds).SQL;
|
|
end;
|
|
|
|
function TDASchema.FindCommandStatement(const aConnection: IDAConnection; aSQLCommand: TDASQLCommand; aStatementName: string=''): TDAStatement;
|
|
var
|
|
connname: string;
|
|
i: integer;
|
|
begin
|
|
// Tries to find the statement associated with the given connection
|
|
|
|
result := nil;
|
|
if (aConnection <> nil) then begin
|
|
connname := aConnection.Name;
|
|
result := TDAStatement(aSQLCommand.Statements.FindItem(connname, aStatementName));
|
|
end;
|
|
|
|
//check for statement matching the connection TYPE of the active connection [matching means same *non-empty* value for both]
|
|
if (Result = nil) and (aConnection.ConnectionType<>'') then begin
|
|
For i:=0 to aSQLCommand.Statements.Count-1 do
|
|
if AnsiSameText(aConnection.ConnectionType,aSQLCommand.Statements[i].ConnectionType) then begin
|
|
Result:=aSQLCommand.Statements[i];
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
//check for a default statement ["Default" is new property on statement]
|
|
if (Result = nil) then
|
|
For i:=0 to aSQLCommand.Statements.Count-1 do
|
|
if aSQLCommand.Statements[i].Default then begin
|
|
Result:=aSQLCommand.Statements[i];
|
|
Break;
|
|
end;
|
|
|
|
// If none is found then reverts to the default connection
|
|
if (result = nil) then begin
|
|
connname := ConnectionManager.GetDefaultConnectionName;
|
|
result := TDAStatement(aSQLCommand.Statements.FindItem(connname, aStatementName));
|
|
end;
|
|
|
|
Check(result = nil, err_CannotFindStatement, [aSQLCommand.Name, connname]);
|
|
end;
|
|
|
|
{function TDASchema.NewDataset(aConnectionName: string; const aName: string): IDADataset;
|
|
begin
|
|
Check(not Assigned(ConnectionManager), err_ConnectionManagerNotAssigned);
|
|
result := NewDataset(ConnectionManager.NewConnection(aConnectionName), aName);
|
|
end;}
|
|
|
|
function TDASchema.NewDataset(const aConnection: IDAConnection;
|
|
const aName: string; aDynSelectFields: array of string;
|
|
aWhereClause: WideString; aStatementName: string;
|
|
OpenIt: boolean;AlwaysGenerateDynamicWhereStatement:Boolean): IDADataset;
|
|
|
|
var
|
|
ds: TDADataset;
|
|
fld : TDAField;
|
|
|
|
function IsRealField(aFieldName: string; ACheckForCalulated: boolean): boolean;
|
|
begin
|
|
Result:=not SameText(aFieldName, def_SourceTableFieldName);
|
|
if Result and ACheckForCalulated then begin
|
|
fld:=ds.Fields.FindField(aFieldName);
|
|
if fld <> nil then
|
|
Result:= not fld.Calculated;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
sql: string;
|
|
statement: TDAStatement;
|
|
i,j: integer;
|
|
lConnection: IDAConnection;
|
|
lFields: TDAFieldCollection;
|
|
lFields2:TDAFieldCollection;
|
|
lColumnMapping: TDAColumnMapping;
|
|
lfldStr: string;
|
|
lWhereFields: TWhereFieldsArray;
|
|
lWhereFlag: Boolean;
|
|
lstatname: string;
|
|
begin
|
|
lConnection := aConnection;
|
|
if not assigned(lConnection) then begin
|
|
CheckProperties;
|
|
lConnection := ConnectionManager.NewConnection(ConnectionManager.GetDefaultConnectionName);
|
|
end;
|
|
result := nil;
|
|
SetLength(lWhereFields,0); // remove warning
|
|
ds := (Datasets.FindItem(aName) as TDADataset);
|
|
if Assigned(ds) then begin
|
|
statement := FindCommandStatement(lConnection, ds, aStatementName);
|
|
sql := statement.SQL;
|
|
// generate AutoSQL
|
|
if statement.StatementType = stAutoSQL then begin
|
|
if statement.TargetTable = '' then begin
|
|
if statement.Name = '' then
|
|
lstatname:= '['+statement.ConnectionType+']'
|
|
else
|
|
lstatname:= statement.Name;
|
|
raise Exception.Create(aName+'. Statement: '+lstatname+ '. TargetTable must be specified.');
|
|
end;
|
|
With aConnection.GetQueryBuilder do try
|
|
if Length(aDynSelectFields) > 0 then begin
|
|
For i:=0 to High(aDynSelectFields) do begin
|
|
fld:=ds.Fields.FindField(aDynSelectFields[i]);
|
|
if not (not Assigned(fld) or fld.Calculated or fld.Lookup or fld.ServerCalculated) then
|
|
AddSelect('',fld.Name);
|
|
end;
|
|
end
|
|
else begin
|
|
For i:=0 to ds.Fields.Count-1 do begin
|
|
fld:=ds.Fields[i];
|
|
if not (fld.Calculated or fld.Lookup or fld.ServerCalculated) then
|
|
AddSelect('',fld.Name);
|
|
end;
|
|
end;
|
|
MainTable.MasterTable:=statement.TargetTable;
|
|
if (aWhereClause <> '') or AlwaysGenerateDynamicWhereStatement then
|
|
Options := Options + [qboGenerateDynamicWhereStatement];
|
|
ColumnMapping:=statement.ColumnMappings;
|
|
sql := GenerateSelectSQL;
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
if Assigned(fOnGetSQL) then fOnGetSQL(Self, aName, setDataset, sql);
|
|
|
|
result := lConnection.NewDataset(sql, aName);
|
|
|
|
if (aWhereClause <> '') then begin
|
|
Result.DynamicWhere.Xml := aWhereClause;
|
|
|
|
// Checking conformity dynamic where fields to table fields
|
|
lWhereFields := Where_ExtractFieldNames(Result.DynamicWhere.Expression);
|
|
if Length(lWhereFields) <> 0 then begin
|
|
{// remapping
|
|
for i:=0 to High(lWhereFields) do begin
|
|
lColumnMapping := statement.ColumnMappings.FindMappingByDatasetField(lWhereFields[i]);
|
|
if Assigned(lColumnMapping) then lWhereFields[i] := lColumnMapping.TableField;
|
|
end;
|
|
}
|
|
if Length(aDynSelectFields) > 0 then begin
|
|
For i:= 0 to High(lWhereFields) do begin
|
|
lWhereFlag:=False;
|
|
for j:=0 to High(aDynSelectFields) do
|
|
if IsRealField(aDynSelectFields[j],True) then
|
|
if SameText(lWhereFields[i],aDynSelectFields[j]) then begin
|
|
lWhereFlag:=True;
|
|
break;
|
|
end;
|
|
if not lWhereFlag then
|
|
raise EDAException.CreateFmt('''%s'' field can''t be used inside the where clause',[lWhereFields[i]]);
|
|
end;
|
|
end
|
|
else begin
|
|
For i:= 0 to High(lWhereFields) do begin
|
|
lWhereFlag:=False;
|
|
for j:=0 to ds.Fields.Count-1 do
|
|
if not ds.Fields[j].Calculated and IsRealField(ds.Fields[j].Name, False) then
|
|
if SameText(lWhereFields[i],ds.Fields[j].Name) then begin
|
|
lWhereFlag:=True;
|
|
break;
|
|
end;
|
|
if not lWhereFlag then
|
|
raise EDAException.CreateFmt('''%s'' field can''t be used inside the where clause',[lWhereFields[i]]);
|
|
end;
|
|
end;
|
|
end;
|
|
// end Checking conformity dynamic where fields to table fields
|
|
Result.DynamicWhere.ColumnMapping := statement.ColumnMappings;
|
|
end;
|
|
|
|
// Copies the definitions of the schema
|
|
|
|
{ not sure if this is unproblematic, but we need to copy access to the data
|
|
dictionary. though some more explicit access (say a Fields.DataDictionary
|
|
property would be better. }
|
|
|
|
result.Fields.DataDictionary := self.DataDictionary;
|
|
if statement.StatementType <> stAutoSQL then begin
|
|
result.Fields.AssignFieldCollection(ds.Fields);
|
|
|
|
with statement do
|
|
for i := 0 to (ColumnMappings.Count - 1) do begin
|
|
fld := result.Fields.FieldByName(ColumnMappings[i].DatasetField);
|
|
|
|
fld.TableField := ColumnMappings[i].TableField;
|
|
fld.SQLOrigin := ColumnMappings[i].SQLOrigin;
|
|
end;
|
|
end else begin
|
|
// stAutoSQL
|
|
lFields:=nil;
|
|
if ds.Fields.Count = 0 then begin
|
|
lConnection.GetTableFields(statement.TargetTable,lFields);
|
|
lFields2:=lFields;
|
|
end
|
|
else begin
|
|
lFields2:=ds.Fields;
|
|
end;
|
|
try
|
|
if Length(aDynSelectFields) > 0 then begin
|
|
For i:=0 to High(aDynSelectFields) do begin
|
|
lColumnMapping:=statement.ColumnMappings.FindMappingByDatasetField(aDynSelectFields[i]);
|
|
if lColumnMapping = nil then
|
|
lfldStr:=aDynSelectFields[i]
|
|
else
|
|
lfldStr:=lColumnMapping.DatasetField;
|
|
fld:=Result.Fields.Add;
|
|
fld.AssignField(lfields2.FieldByName(lfldStr));
|
|
if lColumnMapping <> nil then begin
|
|
fld.Name := lColumnMapping.DatasetField;
|
|
fld.TableField := lColumnMapping.TableField;
|
|
fld.SQLOrigin := lColumnMapping.SQLOrigin;
|
|
end;
|
|
end
|
|
end
|
|
else begin
|
|
result.Fields.AssignFieldCollection(lfields2);
|
|
with statement do
|
|
for i := 0 to (ColumnMappings.Count - 1) do begin
|
|
fld := Result.Fields.FindField(ColumnMappings[i].DatasetField);
|
|
if fld = nil then Continue;
|
|
fld.Name := ColumnMappings[i].DatasetField;
|
|
fld.TableField := ColumnMappings[i].TableField;
|
|
fld.SQLOrigin := ColumnMappings[i].SQLOrigin;
|
|
end;
|
|
end;
|
|
finally
|
|
if lFields <> nil then lFields.Free;
|
|
end;
|
|
end;
|
|
// checking for DynamicFields
|
|
if Length(aDynSelectFields) > 0 then begin
|
|
For i:=0 to High(aDynSelectFields) do
|
|
if IsRealField(aDynSelectFields[i],True) then
|
|
Result.FieldByName(aDynSelectFields[i]);
|
|
end;
|
|
result.Params.AssignParamCollection(ds.Params);
|
|
if OpenIt then result.Open;
|
|
|
|
end;
|
|
end;
|
|
|
|
function TDASchema.NewCommand(const aConnection: IDAConnection; const aName: string; aStatementName: string=''): IDASQLCommand;
|
|
var
|
|
statement: TDAStatement;
|
|
sql: string;
|
|
cmd: TDASQLCommand;
|
|
lConnection: IDAConnection;
|
|
begin
|
|
lConnection := aConnection;
|
|
if not assigned(lConnection) then begin
|
|
CheckProperties;
|
|
lConnection := ConnectionManager.NewConnection(ConnectionManager.GetDefaultConnectionName);
|
|
end;
|
|
result := nil;
|
|
cmd := TDASQLCommand(Commands.ItemByName(aName));
|
|
|
|
statement := FindCommandStatement(lConnection, cmd, aStatementName);
|
|
sql := statement.SQL;
|
|
|
|
if Assigned(fOnGetSQL) then fOnGetSQL(Self, aName, setCommand, sql);
|
|
|
|
result := lConnection.NewCommand(sql, statement.StatementType, aName);
|
|
|
|
// Copies the definitions of the schema
|
|
result.Params.AssignParamCollection(cmd.Params);
|
|
end;
|
|
|
|
procedure TDASchema.Clear;
|
|
begin
|
|
Datasets.Clear();
|
|
Commands.Clear();
|
|
JoinDataTables.Clear();
|
|
UnionDataTables.Clear();
|
|
end;
|
|
|
|
function TDASchema.NewDataset(const aConnection: IDAConnection;
|
|
const aName: string; const ParamNames: array of string;
|
|
const ParamValues: array of Variant; aDynSelectFields: array of string;
|
|
aWhereClause: WideString; OpenIt: boolean;
|
|
aStatementName: string): IDADataset;
|
|
var
|
|
i: integer;
|
|
begin
|
|
if (High(ParamNames) <> High(ParamValues)) then RaiseError('Names and values counts are different');
|
|
|
|
result := NewDataset(aConnection, aName, aDynSelectFields, aWhereClause, aStatementName, False);
|
|
|
|
for i := 0 to High(ParamValues) do
|
|
result.ParamByName(ParamNames[i]).Value := ParamValues[i];
|
|
|
|
if OpenIt then result.Open;
|
|
end;
|
|
|
|
function TDASchema.NewCommand(const aConnection: IDAConnection; const aName: string;
|
|
const ParamNames: array of string;
|
|
const ParamValues: array of Variant;
|
|
ExecuteIt: boolean = TRUE;
|
|
aStatementName: string=''): IDASQLCommand;
|
|
var
|
|
i: integer;
|
|
begin
|
|
if (High(ParamNames) <> High(ParamValues)) then RaiseError('Names and values counts are different');
|
|
|
|
result := NewCommand(aConnection, aName);
|
|
|
|
for i := 0 to High(ParamValues) do
|
|
result.ParamByName(ParamNames[i]).Value := ParamValues[i];
|
|
|
|
if ExecuteIt then result.Execute;
|
|
end;
|
|
|
|
procedure TDASchema.SetUpdateRules(const Value: TDAUpdateRuleCollection);
|
|
begin
|
|
fUpdateRules.Assign(Value);
|
|
end;
|
|
|
|
procedure TDASchema.SetRelationShips(
|
|
const Value: TDADatasetRelationshipCollection);
|
|
begin
|
|
fRelationShips.Assign(Value);
|
|
end;
|
|
|
|
procedure TDASchema.SetDiagrams(const Value: TDADiagrams);
|
|
begin
|
|
if fDiagrams <> Value then begin
|
|
fDiagrams := Value;
|
|
if (fDiagrams <> nil) then fDiagrams.FreeNotification(Self);
|
|
end;
|
|
|
|
end;
|
|
|
|
procedure TDASchema.Copy(aSourceSchema : TDASchema;
|
|
DatasetNames : array of string;
|
|
CommandNames : array of string;
|
|
UpdateRuleNames : array of string;
|
|
RelationShipNames : array of string);
|
|
var i : integer;
|
|
sourcedataset,
|
|
destdataset : TDADataset;
|
|
sourcecommand,
|
|
destcommand : TDASQLCommand;
|
|
sourceupdaterule,
|
|
destupdaterule : TDAUpdateRule;
|
|
sourcerelationship,
|
|
destrelationship : TDADatasetRelationship;
|
|
begin
|
|
for i := 0 to High(DatasetNames) do begin
|
|
sourcedataset := aSourceSchema.Datasets.DatasetByName(DatasetNames[i]);
|
|
destdataset := Datasets.Add;
|
|
destdataset.Assign(sourcedataset);
|
|
end;
|
|
|
|
for i := 0 to High(CommandNames) do begin
|
|
sourcecommand := aSourceSchema.Commands.SQLCommandByName(CommandNames[i]);
|
|
destcommand := Commands.Add;
|
|
destcommand.Assign(sourcecommand);
|
|
end;
|
|
|
|
for i := 0 to High(UpdateRuleNames) do begin
|
|
sourceupdaterule := aSourceSchema.UpdateRules.UpdateRuleByName(UpdateRuleNames[i]);
|
|
destupdaterule := UpdateRules.Add;
|
|
destupdaterule.Assign(sourceupdaterule);
|
|
end;
|
|
|
|
for i := 0 to High(RelationShipNames) do begin
|
|
sourcerelationship := aSourceSchema.RelationShips.RelationShipByName(RelationShipNames[i]);
|
|
destrelationship := RelationShips.Add;
|
|
destrelationship.Assign(sourcerelationship);
|
|
end;
|
|
end;
|
|
|
|
procedure TDASchema.Copy(aSourceSchema : TDASchema;
|
|
IncludeDatasets : boolean = TRUE;
|
|
IncludeCommands : boolean = TRUE;
|
|
IncludeUpdateRules : boolean = TRUE;
|
|
IncludeRelationShips : boolean = TRUE);
|
|
var datasetnames, commandnames, updaterulenames, relationshipnames : array of string;
|
|
i : integer;
|
|
begin
|
|
if not IncludeDatasets then SetLength(datasetnames, 0)
|
|
else begin
|
|
SetLength(datasetnames, aSourceSchema.Datasets.Count);
|
|
for i := 0 to (aSourceSchema.Datasets.Count-1) do
|
|
datasetnames[i] := aSourceSchema.Datasets[i].Name;
|
|
end;
|
|
|
|
if not IncludeCommands then SetLength(commandnames, 0)
|
|
else begin
|
|
SetLength(commandnames, aSourceSchema.Commands.Count);
|
|
for i := 0 to (aSourceSchema.Commands.Count-1) do
|
|
commandnames[i] := aSourceSchema.Commands[i].Name;
|
|
end;
|
|
|
|
if not IncludeUpdateRules then SetLength(updaterulenames, 0)
|
|
else begin
|
|
SetLength(updaterulenames, aSourceSchema.UpdateRules.Count);
|
|
for i := 0 to (aSourceSchema.UpdateRules.Count-1) do
|
|
updaterulenames[i] := aSourceSchema.UpdateRules[i].Name;
|
|
end;
|
|
|
|
if not IncludeRelationShips then SetLength(relationshipnames, 0)
|
|
else begin
|
|
SetLength(relationshipnames, aSourceSchema.RelationShips.Count);
|
|
for i := 0 to (aSourceSchema.RelationShips.Count-1) do
|
|
relationshipnames[i] := aSourceSchema.RelationShips[i].Name;
|
|
end;
|
|
|
|
Copy(aSourceSchema, datasetnames, commandnames, updaterulenames, relationshipnames);
|
|
end;
|
|
|
|
procedure TDASchema.CheckProperties;
|
|
begin
|
|
Check(not assigned(ConnectionManager), Name+'.ConnectionManager must be assigned.');
|
|
Check(ConnectionManager.GetDefaultConnectionName = '', Name+'.ConnectionManager does not have a default connection.');
|
|
|
|
end;
|
|
|
|
function TDASchema.FindDataset(aDatasetName: String): TDADataset;
|
|
begin
|
|
result := Self.fDatasets.FindItem(aDatasetName) as TDADataset;
|
|
if not Assigned(result) then
|
|
result := Self.fUnionDataTables.FindItem(aDatasetName) as TDADataset;
|
|
if not Assigned(result) then
|
|
result := Self.fJoinDataTables.FindItem(aDatasetName) as TDADataset;
|
|
end;
|
|
|
|
function TDASchema.NewDataset(const aConnection: IDAConnection;
|
|
const aName: string;
|
|
aStatementName: string='';
|
|
OpenIt: boolean = false): IDADataset;
|
|
begin
|
|
result := NewDataset(aConnection, aName, [], '', aStatementName, OpenIt);
|
|
end;
|
|
|
|
function TDASchema.NewDataset(const aConnection: IDAConnection; const aName: string;
|
|
const ParamNames: array of string;
|
|
const ParamValues: array of Variant;
|
|
OpenIt: boolean = TRUE;
|
|
aStatementName: string=''): IDADataset;
|
|
begin
|
|
result := NewDataset(aConnection, aName, ParamNames, ParamValues,[],'', OpenIt,aStatementName);
|
|
end;
|
|
|
|
function TDASchema.GetDataDictionary: IDADataDictionary;
|
|
begin
|
|
Result := fDataDictionary;
|
|
end;
|
|
|
|
procedure TDASchema.SaveToStream(aStream: TStream;
|
|
aFormat: TDAPersistFormat);
|
|
begin
|
|
fMergeDataDictionaries := true;
|
|
try
|
|
inherited SaveToStream(aStream, aFormat);
|
|
finally
|
|
fMergeDataDictionaries := false;
|
|
end;
|
|
end;
|
|
|
|
function TDASchema.MergeDataDictionaries: Boolean;
|
|
begin
|
|
result := fMergeDataDictionaries;
|
|
end;
|
|
|
|
{ TDADiagrams }
|
|
|
|
procedure TDADiagrams.DefineProperties(Filer: TFiler);
|
|
begin
|
|
inherited;
|
|
Filer.DefineProperty('DiagramData', ReadDiagramData, WriteDiagramData, fDiagramData <> '');
|
|
end;
|
|
|
|
procedure TDADiagrams.LoadFromFile(const aFilename: string);
|
|
var
|
|
t: TextFile;
|
|
S: string;
|
|
begin
|
|
AssignFile(t, aFilename);
|
|
Reset(t);
|
|
try
|
|
fDiagramData := '';
|
|
while not Eof(t) do begin
|
|
Readln(t, s);
|
|
fDiagramData := fDiagramData+s+#13#10;
|
|
end;
|
|
finally
|
|
CloseFile(t);
|
|
end;
|
|
end;
|
|
|
|
procedure TDADiagrams.SaveToFile(const aFilename: string);
|
|
var
|
|
t:TextFile;
|
|
begin
|
|
AssignFile(t, aFilename);
|
|
Rewrite(t);
|
|
try
|
|
Write(t, fDiagramData);
|
|
finally
|
|
CloseFile(t);
|
|
end;
|
|
end;
|
|
|
|
procedure TDADiagrams.ReadDiagramData(Reader: TReader);
|
|
begin
|
|
fDiagramData := Reader.ReadString;
|
|
end;
|
|
|
|
procedure TDADiagrams.WriteDiagramData(Writer: TWriter);
|
|
begin
|
|
Writer.WriteString(fDiagramData);
|
|
end;
|
|
|
|
end.
|