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<>'') 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.