{*********************************************************} { } { ZMSQL } { SQL enhanced in-memory dataset } { } { Original developer: Zlatko Matić, 2009 } { e-mail: matalab@gmail.com } { Milkovićeva 6, Mala Ostrna, 10370 Dugo Selo, Croatia. } { } {*********************************************************} { This file is copyright (c) 2011 by Zlatko Matić This source code is distributed under the Library GNU General Public License (see the file COPYING) with the following modification: As a special exception, the copyright holders of this library give you permission to link this library with independent modules to produce an executable, regardless of the license terms of these independent modules, and to copy and distribute the resulting executable under terms of your choice, provided that you also meet, for each linked independent module, the terms and conditions of the license of that module. An independent module is a module which is not derived from or based on this library. If you modify this library, you may extend this exception to your version of the library, but you are not obligated to do so. If you do not wish to do so, delete this exception statement from your version. If you didn't receive a copy of the file COPYING, contact: Free Software Foundation 675 Mass Ave Cambridge, MA 02139 USA Modifications are made by Zlatko Matić and contributors for purposes of zmsql package. **********************************************************************} {----------------------------------------------------------------------------- The original developer of the code is Zlatko Matić (matalab@gmail.com or matic.zlatko@gmail.com). Contributor(s): -Mario Ferrari (mario.ferrari@edis.it or mario@marioferrari.org) Changes enclosed within {MF begin} and {MF end} Last Modified: 07.03.2014 Known Issues: - Extremely slow query execution when more than one table joined in query when there is additional where clause in query. It can be overcomed with "ASSIGN TO variable" non-standard expression -->first execute query on a table with where clasue, assign resultset to a variable and then use the variable in second query (instead of the table). - JanSQL has problems with typecasts. - Parameters support is currently quite limited. Basically, named parameters must be used and they are replaced by its values as literal strings. -->You must enclose parameter identifiers in SQL string by quotes! History (Change log): ZMSQL version 0.1.0, 13.07.2011: by Zlatko Matić ZMSQL version 0.1.1, 26.07.2011: by Zlatko Matić ZMSQL version 0.1.2, 28.07.2011: by Zlatko Matić ZMSQL version 0.1.3, 02.08.2011: by Zlatko Matić ZMSQL version 0.1.5, 12.08.2011: by Zlatko Matić ZMSQL version 0.1.6, 28.12.2011: by Zlatko Matić ZMSQL version 0.1.7, 01.01.2012: by Zlatko Matić ZMSQL version 0.1.8, 08.01.2012: by Zlatko Matić ZMSQL version 0.1.9, 15.01.2012: by Zlatko Matić ZMSQL version 0.1.10, 20.01.2012: by Zlatko Matić ZMSQL version 0.1.11, 05.02.2012: by Zlatko Matić ZMSQL version 0.1.12, 12.02.2012: by Zlatko Matić ZMSQL version 0.1.13, 13.01.2013: by Zlatko Matić ZMSQL version 0.1.14, 01.01.2014: by Zlatko Matić ZMSQL version 0.1.15, 28.01.2014: by Zlatko Matić *Internal optimizations and bugfixes. *Autoincrement fields (ftAutoInc) are now working. *Improved visibility of TDataset methods and properties. *ZMQueryDataset now works with TBufDataset as ancestor (as in CodeTyphon v.4.70). ZMBufDataset upgraded to the current TBufDataset in CodeTyphon v. 4.70. *Added property MasterDetailFilter: Boolean which switches master/detail filtration on/off. *Removed property DecimalSeparator. ZMSQL now use system settings for decimal and thousand separator. *ZMQueryDataset can handle float value even if thousand separator is present (in a .csv file). *Better handling locale settings and conversion from ANSI to UTF8. *Persistent fields are working now. (Solved by a trick: persistent fields loaded from .lfm are recreated, propertis from old fields are copied to new fields and old fields are deleted. ZMSQL version 0.1.16, 28.01.2014: by Zlatko Matić *Internal optimizations and bugfixes. *Creation of JanSQL instances moved from ZMConnection to ZMQueryDataset, in order that ZMQueryDataset can be used in multithreaded applications. *New properties (ReferentialUpdateFired, ReferentialDeleteFired, ReferentialInsertFired) that tells that a referential action is in progress. ZMSQL version 0.1.17, 07.03.2014: by Mario Ferrari *Error situations that used ShowMessage now raise a generic exception containing the message itself. Only one ShowMessage remains for a design-time case. ZMSQL version 0.1.18, 10.04.2014: by Zlatko Matić *Bugfix release. There was funny bug in zmquerydataset destroy method - dataset would be saved prior destroying if persistent save was enebaled. This was wrong, causing saving CSV file copy in wrong directories. ZMSQL version 0.1.19, 08.02.2015: by Zlatko Matić *New component TZMQueryBuilder, based on Open QBuilder Engine, is added to the zmsql package. TZMQueryBuilder uses TOQBEngineZmsql, which is TOQBEngine descendant. TOQBEngineZmsql is in based on code of the Open QBuilder Engine for SQLDB Sources created by Reinier Olislagers, modified and adapted for the ZMSQL by Zlatko Matić. It incorporates QBuilder visual query builder(Copyright (c) 1996-2003 Sergey Orlik , Copyright (c) 2003 Fast Reports, Inc.) *Added procedure TZMConnection.GetTableNames(FileList: TStrings); *Added procedure TZMQueryDataSet.LoadTableSchema; -----------------------------------------------------------------------------} unit ZMQueryDataSet; {$mode objfpc}{$H+} {$off DEFINE ZMBufDataset} //=== ct9999 for CodeTyphon ============== {Use "$DEFINE ZMBufDataset" compiler directive to base TZMQueryDataset on TZMBufDataset or use "$OFF DEFINE ZMBufDataset" compiler directive to base TZMQueryDataset on TBufDataset. Optionally you can set {$DEFINE ZMBufDataset} in zmsql package under Options/Compiler Options/Other/Conditionals/Custom Options/Defines. if you switch it on, TZMBufDataset is ancestor, if you swithc it off, TBufDataset is ancestor.} interface uses {$IFDEF UNIX}{ clocale, cwstring,}{$ENDIF} Classes, SysUtils, {LResources, Forms, Controls, Graphics, Dialogs,} db, TypInfo, fpDBExport, fpcsvexport, fpstdexports, SdfData, StrUtils, FileUtil, LConvEncoding, lazutf8, {$IFDEF ZMBufDataset} ZMBufDataset, {$ELSE} BufDataset, {$ENDIF} ZMConnection, jansql {$ifdef VISUAL} ,ComponentEditors, PropEdits, FormEditingIntf, FieldsEditor{$endif}; type TSourceData=(sdSdfDataset, sdJanSQL, sdOtherDataset, sdInternal); TInspectFields=(ifCreateFieldsFromFieldDefs, ifCreateFieldDefsAndFields, ifDoNothing, ifNewIsEmpty, ifOther); TFieldDelimiter = (fdSemicolon, fdTab, fdComma, fdBar, fdColon, fdDash, fdSlash, fdBackSlash); // ; #9 , | : - / \ { TZMQueryDataSet } {$IFDEF ZMBufDataset} TZMQueryDataSet = class(TZMBufDataSet) {$ELSE} TZMQueryDataSet = class(TBufDataSet) {$ENDIF} private { Private declarations } FAutoIncIdx: integer; /// edgarrod71@gmail.com FAutoIncValue: SizeInt; /// edgarrod71@gmail.com FBulkInsert:Boolean; FCSVExporterExport: TCSVExporter; FDisableMasterDetailFiltration: Boolean; FDoReferentialUpdate:Boolean; FDynamicFieldsCreated: Boolean; FFieldCount:Integer; //This is number of columns (fielddefs) that dataset will have after an action (after loading from a table, after loading from a dataset, after query execution....) FFieldDelimiter: TFieldDelimiter; FFieldsLoaded: boolean; //// edgarrod71@gmail.com FJanSQLInstance:TjanSQL; FMasterDataSetTo: TList; FMasterDetailFiltration: Boolean; FMasterFields: TStrings; FMasterReferentialKeys: TList; FMasterSource: TDataSource; FMemoryDataSetOpened: Boolean; FOldMasterSource:TDataSource; FOldRecord:{$IFDEF ZMBufDataset} TZMBufDataSet {$ELSE} TBufDataSet {$ENDIF}; FOriginalSQL:String; FOtherDatasetImport:TDataset; FParameters: TParams; FPersistentFieldsCreated: Boolean; FPersistentSave: Boolean; FPreparedSQL:String; FQueryExecuted: Boolean; FRecordCount:Longint; FRecordsetIndex:Integer; FReferentialDeleteFired: Boolean; FReferentialInsertFired: Boolean; FReferentialUpdateFired: Boolean; FSdfDatasetImport:TSdfDataset; FSlaveReferentialKeys: TList; FSourceData:TSourceData; FSQL: TStrings; FTableFile: TFileStream; FTableLoaded: Boolean; FTableName: String; FTableSaved: Boolean; FZMConnection: TZMConnection; procedure DoCopyFromDataset(pDataset:TDataset); procedure DoCreatePersistentFieldsFromFieldDefs; procedure DoLoadTableSchema; procedure DoLoadFromTable; procedure DoQueryExecute; procedure ManageFields; procedure SetConnection(const AValue: TZMConnection); procedure SetDynamicFieldsCreated(AValue: Boolean); procedure SetMasterDetailFiltration(AValue: Boolean); procedure SetMemoryDataSetOpened(AValue: Boolean); procedure SetDisableMasterDetailFiltration(const AValue: Boolean); procedure SetMasterDataSetTo(const AValue: TList); procedure SetMasterReferentialKeys(const AValue: TList); procedure SetPersistentFieldsCreated(AValue: Boolean); procedure SetSlaveReferentialKeys(const AValue: TList); procedure SetZMConnection(const AValue: TZMConnection); procedure SetMasterFields(const AValue: TStrings); procedure SetMasterSource(const AValue: TDataSource); procedure SetParameters(const AValue: TParams); procedure SetPersistentSave(const AValue: Boolean); procedure SetTableLoaded(const AValue: Boolean); procedure SetTableName(const AValue: String); procedure SetTableSaved(const AValue: Boolean); procedure SetQueryExecuted(const AValue: Boolean); procedure SetSQL(const AValue: TStrings); procedure PassQueryResult; procedure FieldsFromFieldDefs; procedure FieldsFromScratch; procedure EmptySdfDataSet; procedure ClearSdfDataSet; procedure InsertDataFromCSV; procedure InsertDataFromJanSQL; function InspectFields:TInspectFields; procedure UpdateMasterDataSetTo; procedure CopyARowFromDataset(pDataset: TDataSet); procedure UpdateFOldRecord; function FormatStringToFloat (pFloatString:string):Extended; procedure SetFloatDisplayFormat; procedure SetFloatPrecision; Function ZMInitializePersistentField(AOwner: TComponent; AFieldDef:TFieldDef; AOldPersistentField:TField): TField; protected { Protected declarations } procedure DoFilterRecord({var} out Acceptable: Boolean);override; procedure DoOnNewRecord; override; procedure DoAfterScroll;override; procedure DoBeforeDelete;override; procedure DoBeforeInsert;override; procedure DoBeforeEdit;override; procedure DoBeforePost;override; procedure DoAfterInsert;override; procedure DoAfterPost;override; procedure DoAfterDelete;override; procedure InternalRefresh;override; { TODO : To investigate procedure InternalRefresh;override;! Currently this method is overriden to do nothing. } procedure DoAfterClose;override; procedure dummyProc; public { Public declarations } //Master/detail filtration property MasterDataSetTo:TList read FMasterDataSetTo write SetMasterDataSetTo; // Defines datasets to which self is master in master/detail filtration. property DisableMasterDetailFiltration:Boolean read FDisableMasterDetailFiltration write SetDisableMasterDetailFiltration; //Master/detail filrtation should be temporarily desabled during bulk inserts or updates... //Properties needed for master/detail and referential integrity property MasterReferentialKeys:TList read FMasterReferentialKeys write SetMasterReferentialKeys;//Defines list of referential keys in which self is master dataset. property SlaveReferentialKeys:TList read FSlaveReferentialKeys write SetSlaveReferentialKeys; //Defines list of referential keys in which self is slave dataset. //Other procedure QueryExecute; //Executes SQL query defined in SQL property, on .csv files that are placed in folder defined in ZMConnection property. Resultset of select query is loaded into the the zmquerydataset (self). procedure PrepareQuery; //Prepares parameterized queries for execution: replaces parameters with parameter values for parameterized queries. procedure EmptyDataSet; //Deletes all records from dataset. procedure ClearDataSet; //Deletes records, fields and fielddefs. procedure CopyFromDataset (pDataset:TDataSet); //Copies schema and data from any TDataset. function SortDataset (const pFieldName:String):Boolean; //Ascending/Descending sorting of memory dataset. procedure LoadFromTable; //Loads data (or data and schema) from a .csv file (TableName.csv), set in property TableName, from path specified in ZMConnection property. procedure LoadTableSchema;//Load schema only (without data) from a .csv file (TableName.csv), set in property TableName, from path specified in ZMConnection property. function LoadTableFields: boolean; // edgarrod71@gmail.com Load fields from .csv file (TableName.csv), for single tables. procedure LoadLastRecord; procedure SaveToTable;overload; //Saves data and schema to a .csv file (TableName.csv), set in Tablename property, in path specified in ZMConnection property. procedure SaveToTable(pDecimaSeparator:Char);overload; //Saves data and schema to a .csv file (TableName.csv), set in Tablename property, in path specified in ZMConnection property. procedure CreateDynamicFieldsFromFieldDefs; // Creates fields from predefined fielddefs. To be used in design-time or run-time for memory dataset creation according to predefined fielddefs. procedure CreatePersistentFieldsFromFieldDefs; // Creates PERSISTENT fields from predefined fielddefs. To be used in design-time only. procedure MemoryDataSetOpen; //Executes CreateDynamicFieldsFromFieldDefs and set dataset to Active. procedure MemOpen; /// MemoryDataSetOpen will be maintained for some time for compatibility, but is redundant to say ZMQueryDataSet.MemoryDataSetOpen, instead is shorter this definition... edgarrod71@gmail.com procedure InitializePersistentFields; // Activates persistent fields loaded from .lfm. procedure ResetAutoInc(pStart:SizeInt); //Resets AutoIncrement value to an integer. function AddRecord(const Values: array of Const; pAutoIncPos: Integer=-1): boolean; //// edgarrod71@gmail.com Adds a Record at the end of the DataSet. constructor Create(AOwner: TComponent); override; destructor Destroy; override; property OldRecord:{$IFDEF ZMBufDataset} TZMBufDataSet {$ELSE} TBufDataSet {$ENDIF} read FOldRecord; //Last delete/insert/edit is preserved in this property. property AutoIncValue: SizeInt read FAutoIncValue; property ReferentialUpdateFired:Boolean read FReferentialUpdateFired; //Signalize that referential update is in progress property ReferentialDeleteFired:Boolean read FReferentialDeleteFired; //Signalize that referential delete is in progress property ReferentialInsertFired:Boolean read FReferentialInsertFired; //Signalize that referential insert is in progress property FieldsLoaded: Boolean read FFieldsLoaded write FFieldsLoaded; //// edgarrod71@gmail.com procedure Insert; virtual; //// edgarrod71@gmail.com procedure Post; override; //// edgarrod71@gmail.com published { Published declarations } property ZMConnection:TZMConnection read FZMConnection write SetConnection; //Defines "database" folder path where .csv tables are placed. Instantiates JanSQL database engine. property SQL:TStrings read FSQL write SetSQL; //Unprepared SQL query text. property QueryExecuted:Boolean read FQueryExecuted write SetQueryExecuted; //"True" executes QueryExecute and loads resultset into dataset. property TableName:String read FTableName write SetTableName; //Name of .csv file (without extension) from which is data loaded by LoadFromTable and to which is data and schema saved by SaveToTable. property TableLoaded:Boolean read FTableLoaded write SetTableLoaded; //"True" executes LoadFromTable and loads resultset into dataset. property TableSaved:Boolean read FTableSaved write SetTableSaved; //"True" executes SaveToTable and saves dataset to .csv file defined in TableName property, placed in folder specified by ZMConnection property. property DynamicFieldsCreated:Boolean read FDynamicFieldsCreated write SetDynamicFieldsCreated; //"True" executes CreateDynamicFieldsFromFieldDefs, which creates fields from predefined fielddefs. property PeristentFieldsCreated:Boolean read FPersistentFieldsCreated write SetPersistentFieldsCreated; //"True" executes CreatePersistentFieldsFromFieldDefs, which creates PERSISTENT fields from predefined fielddefs. property MemoryDataSetOpened:Boolean read FMemoryDataSetOpened write SetMemoryDataSetOpened; //"True" executes CreateDynamicFieldsFromFieldDefs and activates dataset for editing. property PersistentSave:Boolean read FPersistentSave write SetPersistentSave; //If "True", insert/delete/edit will immediately be written to underlying .csv file. If "False", then dataset is only in-memory. property Parameters: TParams read FParameters write SetParameters; //Parameters for parameterized SQL text. property FieldDelimiter: TFieldDelimiter read FFieldDelimiter write FFieldDelimiter default fdSemicolon; //Read-only properties for getting info about referential integrity property MasterRefKeysList:TList read FMasterReferentialKeys;//List of referential keys in which self is master dataset. property SlaveRefKeysList:TList read FSlaveReferentialKeys; //List of referential keys in which self is slave dataset. //Master/detail filtration property MasterFields: TStrings read FMasterFields write SetMasterFields; //Fields in masterdatasource, (separated by ";") to be used for master/detail filtration. property MasterSource: TDataSource read FMasterSource write SetMasterSource;//Master datasource for master/detail filtration. property MasterDetailFiltration: Boolean read FMasterDetailFiltration write SetMasterDetailFiltration; //Switches master/detail filtration on/off. property MasterDataSetToList:TList read FMasterDataSetTo; // List of datasets to which self is master in master/detail filtration. //Inherited properties from TZMBufDataset property State; //property Fields; Property FieldDefs; property Filter; property Filtered; property FilterOptions; property Active; property AutoCalcFields; property BeforeOpen; property AfterOpen; property BeforeClose; property AfterClose; property BeforeInsert; property AfterInsert; property BeforeEdit; property AfterEdit; property BeforePost; property AfterPost; property BeforeCancel; property AfterCancel; property BeforeDelete; property AfterDelete; property BeforeScroll; property AfterScroll; property BeforeRefresh; property AfterRefresh; property OnCalcFields; property OnDeleteError; property OnEditError; property OnFilterRecord; property OnNewRecord; property OnPostError; end; implementation uses Variants, ZMReferentialKey; const DELIMITERS: array[TFieldDelimiter] of char = (';', #9, ',', '|', ':', '-', '/', '\'); //fdSemicolon, fdTab, fdComma, fdBar, fdColon, fdDash, fdSlash, fdBackSlash); { TZMQueryDataSet } procedure TZMQueryDataSet.SetZMConnection(const AValue: TZMConnection); begin if FZMConnection=AValue then exit; FZMConnection := AValue; end; procedure TZMQueryDataSet.SetConnection(const AValue: TZMConnection); begin if FZMConnection=AValue then exit; FZMConnection := AValue; end; procedure TZMQueryDataSet.DoQueryExecute; var vSqlResult:Integer; vSqlText:String; vDisableMasterDetailFiltration:Boolean; begin try vDisableMasterDetailFiltration:=DisableMasterDetailFiltration; //Set bulk insert flag and suppress master/detail filtration FBulkInsert := True; DisableMasterDetailFiltration:=True; if not ZMConnection.Connected then ZMConnection.Connect; //Free existing and create new JanSQL database -->It seems that this is neccessary when changing connection. { TODO : Investigate why JanSQL sometimes fails to correctly execute consecutive queries in the same jansql instance. Values stay from previous query. This is a serious bug in jansql. As a temporary solution, jansql instance is recreated for every query. } FJanSQLInstance.Free; FJanSQLInstance:=TJanSQL.Create; try //Connect to JanSQL "database". vSqlText:='connect to '''+ZMConnection.DatabasePath{Full}+''''; {ShowMessage(vSqlText);} vSqlResult:=FJanSQLInstance.SQLDirect(vSqlText); if vSqlResult<>0 then {ShowMessage('Successfully connected to database:'+ZMConnection.DatabasePath)} else {MF begin} // was: ShowMessage('Connection to database: '+ ZMConnection.DatabasePath +' failed! Error: '+FJanSQLInstance.Error); raise Exception.Create('Connection to database: '+ ZMConnection.DatabasePath +' failed! Error: '+FJanSQLInstance.Error); {MF end} {ShowMessage(IntToStr(vSqlResult));} finally FJanSQLInstance.ReleaseRecordset(vSqlResult); end; //Delete previous records Close; //This closes dataset and delets all records from memory {EmptyDataSet;} //This would be alternative to Close, but it has problems if DisableMasterDetailFiltration=True. //Prepare SQL string PrepareQuery; //Execute query in JanSQL engine try FRecordsetIndex:=0; {ShowMessage('Prepared SQL: '+FPreparedSQL);} FRecordsetIndex:=FJanSQLInstance.SQLDirect(FPreparedSQL); {ShowMessage(IntToStr(FRecordsetIndex));} {ShowMessage('FJanSQLInstance.RecordsetCount: '+IntToStr(FJanSQLInstance.RecordsetCount));} except {MF begin} // was: ShowMessage ('Error while trying to execute query.' +FJanSQLInstance.Error); on e:Exception do begin raise Exception.Create('Error while trying to execute query.' +FJanSQLInstance.Error); end; {MF end} end; //If there is a resultset, pass it to ZMQueryDataSet. if FRecordsetIndex>0 then begin try try //Load query result into zmquerydataset PassQueryResult; finally //Persistent save if (FPersistentSave=True) then begin if (FTableName<>null) then SaveToTable {MF begin} // was: else ShowMessage('Dataset '+Name+' can not be saved ' +'because TableName property is not set'); else raise Exception.Create('Dataset '+Name+' can not be saved '#10 +'because TableName property is not set'); {MF end} end; end; finally FJanSQLInstance.ReleaseRecordset(FRecordsetIndex); FRecordsetIndex:=0; end; end; finally //Remove bulk insert flag and enable master/detail filtration FBulkInsert:=False; DisableMasterDetailFiltration:=vDisableMasterDetailFiltration; end; end; procedure TZMQueryDataSet.ManageFields; begin //Decide what to do with FieldDefs and Fields {ShowMessage('InspectFields for dataset: '+self.Name);} Case InspectFields of ifCreateFieldsFromFieldDefs: begin {ShowMessage('InspectFields for dataset: '+self.Name+', '+InspectFields function returned ifCreateFieldsFromFieldDefs.');} FieldsFromFieldDefs; //Create fields from fielddefs //Deal with mutually exclusive properties //// FDynamicFieldsCreated:=True; //// FPersistentFieldsCreated:=False; end; ifCreateFieldDefsAndFields: begin {ShowMessage('InspectFields for dataset: '+self.Name+', '+'InspectFields function returned ifCreateFieldDefsAndFields.');} FieldsFromScratch; //Create both fielddefs and fields //Deal with mutually exclusive properties FDynamicFieldsCreated:=True; FPersistentFieldsCreated:=False; end; ifDoNothing: begin {ShowMessage('InspectFields for dataset: '+self.Name+', '+'InspectFields function returned ifDoNothing.');} //Do nothing end; ifNewIsEmpty: begin {MF begin} // was: ShowMessage('InspectFields for dataset: '+self.Name+', '+'Error: InspectFields function returned ifNewIsEmpty! Canceling...'); raise Exception.Create('InspectFields for dataset: '+self.Name+', '+'Error: InspectFields function returned ifNewIsEmpty! Canceling...'); {MF end} end; ifOther: begin {MF begin} // was: ShowMessage('InspectFields for dataset: '+self.Name+', '+'Error: InspectFields function returned ifOther! Canceling...'); raise Exception.Create('InspectFields for dataset: '+self.Name+', '+'Error: InspectFields function returned ifOther! Canceling...'); {MF end} end; end; end; procedure TZMQueryDataSet.DoLoadTableSchema; var vDisableMasterDetailFiltration:Boolean; begin try vDisableMasterDetailFiltration:=DisableMasterDetailFiltration; //Set bulk inbsert flag and suppress master/detail filtration FBulkInsert:=True; DisableMasterDetailFiltration:=True; if not ZMConnection.Connected then ZMConnection.Connect; //Delete previous records Close; //This closes dataset and delets all records from memory {EmptyDataSet;} //This would be alternative to Close, but it has problems if DisableMasterDetailFiltration=True. // with FSdfDatasetImport do begin FSdfDatasetImport.Close; FSdfDatasetImport.FileName:=ZMConnection.DatabasePath{Full}+ TableName + '.csv'; FSdfDatasetImport.FirstLineAsSchema:=True; FSdfDatasetImport.Delimiter := DELIMITERS[FFieldDelimiter]; FSdfDatasetImport.FileMustExist:=False; FSdfDatasetImport.Open; //Let object knows data source... FSourceData:=sdSdfDataset; FFieldCount:=FSdfDatasetImport.FieldDefs.Count; FRecordCount:=FSdfDatasetImport.RecordCount; // end; //Prepare ZMQueryDataset with self do begin Close; //Decide what to do with FieldDefs and Fields. ManageFields; end; Open; finally //UnSet bulk inbsert flag and Unsuppress master/detail filtration FBulkInsert:=False; DisableMasterDetailFiltration:=vDisableMasterDetailFiltration; end; end; procedure TZMQueryDataSet.DoLoadFromTable; var vDisableMasterDetailFiltration:Boolean; begin try vDisableMasterDetailFiltration:=DisableMasterDetailFiltration; //Set bulk insert flag and suppress master/detail filtration FBulkInsert:=True; DisableMasterDetailFiltration:=True; if not ZMConnection.Connected then ZMConnection.Connect; //Delete previous records Close; //This closes dataset and deletes all records from memory {EmptyDataSet;} //This would be alternative to Close, but it has problems if DisableMasterDetailFiltration=True. with FSdfDatasetImport do begin Close; FileName:=ZMConnection.DatabasePath{Full}+TableName+'.csv'; FirstLineAsSchema:=True; FSdfDatasetImport.Delimiter:= DELIMITERS[FFieldDelimiter]; FSdfDatasetImport.FileMustExist:=False; Open; //Let object knows data source... FSourceData:=sdSdfDataset; FFieldCount:=FieldDefs.Count; FRecordCount:=RecordCount; end; //Prepare ZMQueryDataset with self do begin Close; //Decide what to do with FieldDefs and Fields. ManageFields; end; Open; try //Insert data from the csv file. InsertDataFromCSV; finally //Persistent save if (FPersistentSave=True) then begin if (FTableName<>null) then SaveToTable {MF begin} // was: else ShowMessage('Dataset '+Name+' can not be saved because ' +'TableName property is not set'); else raise Exception.Create('Dataset '+Name+' can not be saved because ' +'TableName property is not set'); {MF end} end; end; finally //UnSet bulk inbsert flag and Unsuppress master/detail filtration FBulkInsert:=False; DisableMasterDetailFiltration:=vDisableMasterDetailFiltration; end; end; procedure TZMQueryDataSet.DoCopyFromDataset(pDataset:TDataset); var n: Integer; vFieldCount: Integer; vFilter:String; vFiltered:Boolean; vDisableMasterDetailFiltration:Boolean; begin vFieldCount:=pDataSet.FieldDefs.Count; if not ZMConnection.Connected then ZMConnection.Connect; //Delete previous records Close; //This closes dataset and delets all records from memory {EmptyDataSet;} //This would be alternative to Close, but it has problems if DisableMasterDetailFiltration=True. //Let object knows data source... FSourceData:=sdOtherDataset; FOtherDatasetImport:=pDataset; FFieldCount:=FOtherDatasetImport.FieldDefs.Count; FRecordCount:=FOtherDatasetImport.RecordCount; //Prepare ZMQueryDataset with self do begin Close; //Decide what to do with FieldDefs and Fields ManageFields; end; Open; //Insert Fields Data. try //Remember whethere pDataSet was filtered. vFilter:=pDataSet.Filter; vFiltered:=pDataSet.Filtered; if (pDataSet is TZMQueryDataSet) then vDisableMasterDetailFiltration:=(pDataSet as TZMQueryDataSet).DisableMasterDetailFiltration; //Disable filter for the pDataSet pDataSet.Filter:=''; pDataSet.Filtered:=False; if (pDataSet is TZMQueryDataSet) then (pDataSet as TZMQueryDataSet).DisableMasterDetailFiltration:=True; //iterate through pDataSet and copy values pDataSet.First; while not pDataSet.EOF do begin Append; for n:=0 to vFieldCount-1 do begin if FieldDefs[n].DataType<>ftAutoInc then begin Fields[n].Value:=pDataSet.Fields[n].Value; end; end; Post; pDataSet.Next; end; finally //restore filter if existed pDataSet.Filter:=vFilter; pDataSet.Filtered:=vFiltered; if (pDataSet is TZMQueryDataSet) then (pDataSet as TZMQueryDataSet).DisableMasterDetailFiltration:=vDisableMasterDetailFiltration; end; end; procedure TZMQueryDataSet.DoCreatePersistentFieldsFromFieldDefs; var NewField: TField; FieldDef: TFieldDef; i: integer; function FieldNameToPascalIdentifer(const AName: string): string; var i : integer; begin Result := ''; // FieldName is an ansistring for i := 1 to Length(AName) do if AName[i] in ['0'..'9','a'..'z','A'..'Z','_'] then Result := Result + AName[i]; if (Length(Result) > 0) and (not (Result[1] in ['0'..'9'])) then Exit; if Assigned(FieldDef.FieldClass) then begin Result := FieldDef.FieldClass.ClassName + Result; if Copy(Result, 1, 1) = 'T' then Result := Copy(Result, 2, Length(Result) - 1); end else Result := 'Field' + Result; end; function CreateFieldName(Owner: TComponent; const AName: string): string; var C: TComponent; j:integer; begin for j := 0 to Owner.ComponentCount - 1 do // for C in Owner do begin if CompareText(Owner.Components[j].Name, AName) = 0 then // if CompareText(C.Name, AName) = 0 then begin {$ifdef VISUAL} Result := FormEditingHook.CreateUniqueComponentName(NewField); {$endif} exit; end; end; Result := AName; end; begin //This procedure creates PERSISTENT Fields from predefined FieldDefs. for I := 0 to Pred(fielddefs.Count) do with FieldDefs.Items[I] do begin FieldDef := Fielddefs.Items[I]; if DataType<>ftUnknown then begin //Create new field and set it's unique name. NewField:=CreateField(self.Owner); //Owner ---> this makes created field to be persistent and visible in object inspector. { NewField:=ZMCreateField(self.Owner,FieldDef); //Owner ---> this makes created field to be persistent and visible in object inspector. } NewField.Name := CreateFieldName(self.Owner, self.Name + FieldNameToPascalIdentifer(NewField.FieldName)); end; //Set initial properties of the field. NewField.FieldKind:=fkData; NewField.SetFieldType(FieldDef.DataType); NewField.Size:=FieldDef.Size; { TODO : Is there any possible way to set read-only property FieldNo??? } {NewField.FieldNo:=FieldDef.FieldNo}; end; end; procedure TZMQueryDataSet.SetDynamicFieldsCreated(AValue: Boolean); begin if FDynamicFieldsCreated=AValue then exit; if AValue then //// if AValue=True then edgarrod71@gmail.com try CreateDynamicFieldsFromFieldDefs; {FDynamicFieldsCreated:=AValue;} //Removed to CreateDynamicFieldsFromFieldDefs procedure. except FDynamicFieldsCreated:=False; Active:=False; end else //// if AValue=False then edgarrod71@gmail.com try { TODO : To reconsider what action in case of SetDynamicFieldsCreated=False. Currently set to do nothing. Caution: if we clear dynamic fields, persistent fields will be deleted too. } { Active:=False; Fields.Clear; } finally FDynamicFieldsCreated:=AValue; Active:=False; //Deal with mutually exclusive properties. FMemoryDataSetOpened:=False; FTableLoaded:=False; FQueryExecuted:=False; end; end; procedure TZMQueryDataSet.SetMasterDetailFiltration(AValue: Boolean); begin if FMasterDetailFiltration=AValue then Exit; FMasterDetailFiltration:=AValue; FDisableMasterDetailFiltration := not AValue; Filtered := AValue; if Active then Refresh; end; procedure TZMQueryDataSet.SetMemoryDataSetOpened(AValue: Boolean); begin if FMemoryDataSetOpened=AValue then Exit; if AValue then //// if (AValue=True) then edgarrod71@gmail.com try MemoryDataSetOpen; {FMemoryDataSetOpened:=AValue;} //This is removed to MemoryDataSetOpen procedure. except FMemoryDataSetOpened:=False; Active:=False; end else ///// if (AValue=False) then edgarrod71@gmail.com try Close; //This closes dataset and delets all records from memory {EmptyDataSet;} //This would be alternative to Close, but it has problems if DisableMasterDetailFiltration=True. finally FMemoryDataSetOpened:=AValue; Active:=False; end; end; procedure TZMQueryDataSet.SetDisableMasterDetailFiltration(const AValue: Boolean); begin if FDisableMasterDetailFiltration=AValue then exit; FDisableMasterDetailFiltration:=AValue; ///// edgarrod71@gmail.com FMasterDetailFiltration := not AValue; //// FMasterDetailFiltration := FDisableMasterDetailFiltration = false Filtered := not AValue; //// Filtered := FDisableMasterDetailFiltration = false if Active then Refresh; end; procedure TZMQueryDataSet.SetMasterDataSetTo(const AValue: TList); begin if FMasterDataSetTo=AValue then exit; FMasterDataSetTo:=AValue; end; procedure TZMQueryDataSet.SetMasterReferentialKeys(const AValue: TList); begin if FMasterReferentialKeys=AValue then exit; FMasterReferentialKeys:=AValue; end; procedure TZMQueryDataSet.SetPersistentFieldsCreated(AValue: Boolean); { TODO : To solve problems with persistent fields } begin if FPersistentFieldsCreated=AValue then exit; if AValue then //// if AValue=True then edgarrod71@gmail.com try //In design-time only, because, in run-time persistent fields should be streamed from .lfm? if (csDesigning in ComponentState) and not (csLoading in ComponentState) and not (csReading in ComponentState) then begin raise Exception.Create('I am going to create persistent fields from fielddefs.'); //ShowMessage('I am going to create persistent fields from fielddefs.'); CreatePersistentFieldsFromFieldDefs; end; {FPersistentFieldsCreated:=AValue; //Removed to CreatePersistentFieldsFromFieldDefs procedure.} { TODO : Setting FPersistentFieldsCreated to True is temporarily disabled, because if PersistentFieldsCreated is True, then persistent fields will be loaded twice (once from stream and second time here) when project loading in design-time.... } FPersistentFieldsCreated:=False; //POOR SOLUTION except FPersistentFieldsCreated:=False; Active:=False; end else /////if AValue=False then { TODO : To reconsider what to do on SetPersistentFieldsCreated=False. Currently set to do nothing. } FPersistentFieldsCreated:=AValue; end; procedure TZMQueryDataSet.SetSlaveReferentialKeys(const AValue: TList); begin if FSlaveReferentialKeys=AValue then exit; FSlaveReferentialKeys:=AValue; end; procedure TZMQueryDataSet.SetMasterFields(const AValue: TStrings); begin if FMasterFields=AValue then exit; FMasterFields.Assign(AValue); end; procedure TZMQueryDataSet.SetMasterSource(const AValue: TDataSource); begin if FMasterSource=AValue then exit; //Remember old master source if Assigned (FMasterSource) then begin FOldMasterSource:=FMasterSource; end; //Set new master data source FMasterSource:=AValue; UpdateMasterDataSetTo; end; procedure TZMQueryDataSet.UpdateMasterDataSetTo; var vAlreadyInList, vToAddNew,vToRemoveOld:Boolean; begin if Assigned (FMasterSource) then vAlreadyInList:=(TObject(FMasterSource.DataSet) as TZMQueryDataSet).MasterDataSetTo.IndexOf(self)>=0 else vAlreadyInList:=False; //Inspect how to update detail datasets list if ((FOldMasterSource<>FMasterSource) and Assigned(FMasterSource)) then vToAddNew:=True else vToAddNew:=False; if ((FOldMasterSource<>FMasterSource) and (vAlreadyInList=True) and Assigned(FOldMasterSource)) then vToRemoveOld:=True else vToRemoveOld:=False; //Update detail datasets list //Append dataset to the list of datasets for which the dataset is master dataset if (vToAddNew=True) then begin (TObject(FMasterSource.DataSet) as TZMQueryDataSet).MasterDataSetTo.Add(self); end; //Remove dataset from the list of datasets for which the dataset is master dataset if (vToRemoveOld=True) then begin (TObject(FOldMasterSource.DataSet) as TZMQueryDataSet).MasterDataSetTo.Remove(self); end; end; procedure TZMQueryDataSet.SetParameters(const AValue: TParams); begin if FParameters=AValue then exit; FParameters:=AValue; end; procedure TZMQueryDataSet.SetPersistentSave(const AValue: Boolean); begin if FPersistentSave=AValue then exit; FPersistentSave:=AValue; end; procedure TZMQueryDataSet.SetTableLoaded(const AValue: Boolean); begin if FTableLoaded=AValue then exit; if AValue then ////if AValue=True then edgarrod71@gmail.com try LoadFromTable; {FTableLoaded:=AValue; } //This is removed inside LoadFromTable procedure. except FTableLoaded:=False; Active:=False; end else ////if AValue=False then edgarrod71@gmail.com try Close; //This closes dataset and deletes all records from memory {EmptyDataSet;} //This would be alternative to Close, but it has problems if DisableMasterDetailFiltration=True. finally FTableLoaded:=AValue; Active:=False; end; end; procedure TZMQueryDataSet.SetTableName(const AValue: String); begin if FTableName=AValue then exit; FTableName:=AValue; end; procedure TZMQueryDataSet.SetTableSaved(const AValue: Boolean); begin if FTableSaved=AValue then exit; if AValue then /////if AValue=True then edgarrod71@gmail.com try SaveToTable; FTableSaved:=AValue; finally FTableSaved:=False; end else ////if AValue=False then FTableSaved:=AValue; end; procedure TZMQueryDataSet.SetQueryExecuted(const AValue: Boolean); begin if FQueryExecuted=AValue then exit; if AValue then /// if AValue=True then edgarrod71@gmail.com try if not ZMConnection.Connected then ZMConnection.Connect; ////.Connected:=True; edgarrod71@gmail.com QueryExecute; {FQueryExecuted :=AValue;} //Moved to QueryExecute procedure. except FQueryExecuted :=False; Active:=False; end else /// if AValue = false edgarrod71@gmail.com try EmptyDataSet; //Delete records from the dataset. FJanSQLInstance.ReleaseRecordset(FRecordsetIndex); finally FQueryExecuted:=AValue; Active:=False; end; end; procedure TZMQueryDataSet.SetSQL(const AValue: TStrings); begin if FSQL=AValue then exit; FSQL.Assign(AValue); end; procedure TZMQueryDataSet.PassQueryResult; begin FSourceData:=sdJanSQL; FRecordCount:=FJanSQLInstance.RecordSets[FRecordsetIndex].recordcount; FFieldCount:=FJanSQLInstance.RecordSets[FRecordsetIndex].fieldcount; with self do begin //Decide what to do with FieldDefs and Fields ManageFields; //OpenDataset Open; InsertDataFromJanSQL; end; end; procedure TZMQueryDataSet.EmptyDataSet; //This procedure deletes all records from dataset. var vFilter:String; vFiltered:Boolean; begin with self do begin //This is incredible slow in MemDataset, seems to be faster in TBufDataset! try //// test edgarrod71@gmail.com I put Fields.Count inactive, //// because if RecordCount>0 means that Fields were loaded!!! if ({(Fields.Count>0) and }(RecordCount>0) and Active{=True)}) then begin try DisableControls; // edgarrod71@gmail.com //Rememeber filter and disable it while deleting records. vFilter:=Filter; vFiltered:=Filtered; Filter:=''; Filtered:=False; //Delete records. first; repeat Delete; until EOF; finally //Reestablish filter if existed before deletion. Filter:=vFilter; Filtered:=vFiltered; Refresh; //I'm not sure whether this is neccessary... EnableControls; end; end; except {MF begin} // was: ShowMessage('Error in EmptyDataset method, dataset: '+self.Name); on e:Exception do begin raise Exception.Create('Error in EmptyDataset method, dataset: '+self.Name); end; {MF end} end; end; end; procedure TZMQueryDataSet.ClearDataSet; //This procedure deletes both fielddefs and fields, with all data... begin with self do begin if Active{=True} then Close; FieldDefs.Clear; Fields.Clear; end; {Why doesn't it delete all?} end; procedure TZMQueryDataSet.CopyFromDataset(pDataset: TDataSet); //This procedure can copy any dataset data (and if neccessary schema too) to zmquerydataset var vDisableMasterDetailFiltration:Boolean; vFilter:String; vFiltered:Boolean; begin //First, see whether there are present persistent fields and whether they need initialization. InitializePersistentFields; with self do begin try DisableControls; pDataSet.DisableControls; //Remember filters vDisableMasterDetailFiltration:=DisableMasterDetailFiltration; vFilter:=Filter; vFiltered:=Filtered; //Set bulk inbsert flag and suppress master/detail filtration, remove filters FBulkInsert:=True; DisableMasterDetailFiltration:=True; Filter:=''; Filtered:=False; //Do copy from pDataSet DoCopyFromDataset(pDataset); finally FBulkInsert:=False; DisableMasterDetailFiltration:=vDisableMasterDetailFiltration; Filter:=vFilter; Filtered:=vFiltered; EnableControls; pDataset.EnableControls; end; end; end; procedure TZMQueryDataSet.CopyARowFromDataset(pDataset: TDataSet); var vFieldDef:TFieldDef; vFieldCount:Integer; i,n:Integer; begin vFieldCount:=pDataSet.FieldDefs.Count; with self do begin try //Set bulk insert flag FBulkInsert:=True; ClearDataSet; DisableControls; //Create FieldDefs. for i:=0 to vFieldCount-1 do begin vFieldDef:=FieldDefs.AddFieldDef; vFieldDef.Name:=pDataSet.FieldDefs[i].Name; if pDataSet.FieldDefs[i].DataType=ftAutoInc then vFieldDef.DataType:=ftInteger else vFieldDef.DataType:=pDataSet.FieldDefs[i].DataType; vFieldDef.Size:=pDataSet.FieldDefs[i].Size; vFieldDef.Required:=pDataSet.FieldDefs[i].Required; end; MaxIndexesCount:=(2*(FieldDefs.Count)+3); CreateDataSet; //In case of TBufDataset ancestor. Open; //Insert current record from pDataSet. Append; for n:=0 to vFieldCount-1 do begin Fields[n].Value:=pDataSet.Fields[n].Value; end; Post; finally //Remove bulk inbsert flag FBulkInsert:=False; EnableControls; end; end; end; procedure TZMQueryDataSet.UpdateFOldRecord; begin //For referential filtration if Active and (FBulkInsert=False) then TZMQueryDataSet(FOldRecord).CopyARowFromDataSet(self); end; function TZMQueryDataSet.FormatStringToFloat(pFloatString: string):Extended; //Transform float value inside a string with adequate decimal separator. var // modified by edgarrod71@gmail.com vFloatString, vLeftPart, vRightPart:String; vDelimiterPos, I: SizeInt; Dp, Tp, vDecSep: Char; function StrToNumber(aStr:string): string; var P: Pchar; begin p := @aStr[1]; result := ''; repeat if p^ in ['0'..'9','-'] then result += p^; inc(p); until (p = #0) or (p = ''); end; function GetDecSep(aStr: String): Char; var Pa, Pb: PChar; begin I := length(aStr); Pa := @aStr[1]; Pb := @aStr[I]; if (Pa <= Pb) and not(Pb^ in [Dp, Tp]) then repeat dec(Pb) until (Pa > Pb) or (Pb^ in [Dp, TP]); vDelimiterPos := Pb - Pa + 1; result := Pb^; end; begin Result := 0.00; if pFloatString <> '' then begin Dp := SysUtils.DefaultFormatSettings.DecimalSeparator; Tp := SysUtils.DefaultFormatSettings.ThousandSeparator; vDecSep := GetDecSep(pFloatString); if vDecSep <> Dp then case vDecSep of '.': vDecSep := ','; ',': vDecSep := '.'; end; vLeftPart := StrToNumber(copy(pFloatString, 1, Pred(vDelimiterPos))); vRightPart := copy(pFloatString, Succ(vDelimiterPos), I-Pred(vDelimiterPos)); vFloatString := vLeftPart + vDecSep + vRightPart; result := StrToFloat(vFloatString); end end; function TZMQueryDataSet.SortDataset(const pFieldName: String):Boolean; var i: Integer; vIndexDefs: TIndexDefs; vIndexName: String; vIndexOptions: TIndexOptions; vField: TField; begin Result := False; vField := Fields.FindField(pFieldName); //If invalid field name, exit. if vField = nil then Exit; //if invalid field type, exit. if {(vField is TObjectField) or} (vField is TBlobField) or {(vField is TAggregateField) or} (vField is TVariantField) or (vField is TBinaryField) then Exit; //Get IndexDefs and IndexName using RTTI if IsPublishedProp(self, 'IndexDefs') then vIndexDefs := GetObjectProp(self, 'IndexDefs') as TIndexDefs else Exit; if IsPublishedProp(self, 'IndexName') then vIndexName := GetStrProp(self, 'IndexName') else Exit; //Ensure IndexDefs is up-to-date IndexDefs.Update; //If an ascending index is already in use, //switch to a descending index if vIndexName = pFieldName + '__IdxA' then begin vIndexName := pFieldName + '__IdxD'; vIndexOptions := [ixDescending]; end else begin vIndexName := pFieldName + '__IdxA'; vIndexOptions := []; end; //Look for existing index for i := 0 to Pred(IndexDefs.Count) do begin if vIndexDefs[i].Name = vIndexName then begin Result := True; Break end; //if end; // for //If existing index not found, create one if not Result then begin if vIndexName=pFieldName + '__IdxD' then AddIndex(vIndexName, pFieldName, vIndexOptions, pFieldName) else AddIndex(vIndexName, pFieldName, vIndexOptions); Result := True; end; // if not //Set the index SetStrProp(self, 'IndexName', vIndexName); end; procedure TZMQueryDataSet.LoadFromTable; begin DisableControls; //First, see whether there are present persistent fields and whether they need initialization. InitializePersistentFields; try try DoLoadFromTable; //If everything goes well, ensure that corresponding property is set accordingly. FTableLoaded:=True; //Set mutually exclusive properties to False. FQueryExecuted:=False; FMemoryDataSetOpened:=False; except FTableLoaded:=False; Active:=False; end; finally //Refresh self if Active then refresh; FSdfDatasetImport.Close; EnableControls; end; end; procedure TZMQueryDataSet.LoadTableSchema; begin DisableControls; //First, see whether there are present persistent fields and whether they need initialization. InitializePersistentFields; try try DoLoadTableSchema; //If everything goes well, ensure that corresponding property is set accordingly. FTableLoaded:=True; //Set mutually exclusive properties to False. FQueryExecuted:=False; FMemoryDataSetOpened:=False; except FTableLoaded:=False; Active:=False; end; finally //Refresh self if Active then refresh; FSdfDatasetImport.Close; EnableControls; end; end; procedure TZMQueryDataSet.SaveToTable;overload; var vFiltered:Boolean; vFilter:String; vBookmark:TBookmark; vDisableMasterDetailFiltration:Boolean; begin try DisableControls; vDisableMasterDetailFiltration:=DisableMasterDetailFiltration; //Disable Master/Detail filtration DisableMasterDetailFiltration:=True; //Get bookmark vBookmark:=GetBookmark; //Get filter if Filtered=True then vFiltered:=True else vFiltered:=False; vFilter:=Filter; //Temporary disable filters Filtered:=False; //Refresh in order to disable filters DisableControls; if active then Refresh; if active then First; EnableControls; with FCSVExporterExport do begin Dataset:=self; FileName:=ZMConnection.DatabasePath{Full}+TableName+'.csv'; FromCurrent:=False; FormatSettings.FieldDelimiter:= DELIMITERS[FFieldDelimiter]; FormatSettings.HeaderRow:=True; // FormatSettings.QuoteStrings:=[qsAlways]; //=== ct9999 in FPC SVN 30449 NOT Exists ==== FormatSettings.BooleanFalse:='False'; FormatSettings.BooleanTrue:='True'; FormatSettings.DateFormat:='yyyy-mm-dd'; FormatSettings.DateTimeFormat:='yyyy-mm-dd hh:mm:ss'; //Set decimal separator. FormatSettings.DecimalSeparator:=SysUtils.DefaultFormatSettings.DecimalSeparator; Execute; end; //Restore filters. Filter:=vFilter; Filtered:=vFiltered; //Goto bookmark if ((BookmarkAvailable) and (BookmarkValid(vBookmark))) then GotoBookmark(vBookmark); finally //Enable Master/Detail filtration DisableMasterDetailFiltration:=vDisableMasterDetailFiltration; //Refresh in order to enable filters if Active then Refresh; FreeBookmark(vBookmark); EnableControls; end; end; procedure TZMQueryDataSet.SaveToTable(pDecimaSeparator: Char); var vFiltered:Boolean; vFilter:String; vBookmark:TBookmark; vDisableMasterDetailFiltration:Boolean; begin try DisableControls; vDisableMasterDetailFiltration:=DisableMasterDetailFiltration; //Disable Master/Detail filtration DisableMasterDetailFiltration:=True; //Get bookmark vBookmark:=GetBookmark; //Get filter if Filtered=True then vFiltered:=True else vFiltered:=False; vFilter:=Filter; //Temporary disable filters if Active then Filtered:=False; if Active then Refresh; //Goto first record. First; with FCSVExporterExport do begin Dataset:=self; {FileName:=ZMConnection.DatabasePathFull+TableName+'.txt';} FileName:=ZMConnection.DatabasePath{Full}+TableName+'.csv'; FromCurrent:=False; FormatSettings.FieldDelimiter:= DELIMITERS[FFieldDelimiter]; FormatSettings.HeaderRow:=True; // FormatSettings.QuoteStrings:=[qsAlways]; //=== ct9999 in FPC SVN 30449 NOT Exists ==== FormatSettings.BooleanFalse:='False'; FormatSettings.BooleanTrue:='True'; FormatSettings.DateFormat:='yyyy-mm-dd'; FormatSettings.DateTimeFormat:='yyyy-mm-dd hh:mm:ss'; FormatSettings.DecimalSeparator:=pDecimaSeparator; Execute; end; //Restore filters. Filter:=vFilter; Filtered:=vFiltered; //Goto bookmark if ((BookmarkAvailable) and (BookmarkValid(vBookmark))) then GotoBookmark(vBookmark); finally //Enable Master/Detail filtration DisableMasterDetailFiltration:=vDisableMasterDetailFiltration; if Active then Refresh; FreeBookmark(vBookmark); EnableControls; end; end; procedure TZMQueryDataSet.CreateDynamicFieldsFromFieldDefs; //This procedure is used to create Fields from FieldDefs, create the dataset and make it active. begin //Prepare ZMQueryDataset with self do begin FSourceData:=sdInternal; FFieldCount:=FieldDefs.Count; try Close; //Decide what to do with FieldDefs and Fields ManageFields; //If matching persistent fields (match in FieldName and number) are already created, do nothing. //If everything goes ok, set the property accordingly. {FDynamicFieldsCreated:=True;} except FDynamicFieldsCreated:=False; Active:=False; end; end; end; procedure TZMQueryDataSet.CreatePersistentFieldsFromFieldDefs; //This procedure is used to create PERSISTENT Fields from FieldDefs. {var strMsg:String;} begin with self do begin FSourceData:=sdInternal; FFieldCount:=FieldDefs.Count; try Close; // Create PERSISTENT fields from FieldDefs { TODO : To investigate BindFields(False) and DefaultFields in ZMBufDataset and TBufDataset. In Delphi, BindFields(False) disconnects fields object from underlying fields, but it seems that currently this does not work here? Also, DefaultFields should be False in case of persistent fields and True in case of dynamic fields. However, it seems that sometimes it is False even if only dynamic fields are created.} { if InspectFields=ifDoNothing {This means that there are already created corresponding persistent fields.} then begin ShowMessage('InspectFields=ifDoNothing'); if DefaultFields=False {DefaultFields=False means Persistent Fields exist} then begin ShowMessage('DefaultFields=False'); Exit; end; end; } Fields.Clear; //DefaultFields should be False in case of persistent fields? SetDefaultFields(False); DoCreatePersistentFieldsFromFieldDefs; BindFields(True); //Connect persistent Fields objects to underlying Fields. //If everything goes ok, set the property accordingly. FPersistentFieldsCreated:=True; //Deal mutually exclusive property FDynamicFieldsCreated:=False; except {MF begin} // was: ShowMessage('I can not create persistent fields!'); // was: FPersistentFieldsCreated:=False; // was: Active:=False; on e:Exception do begin FPersistentFieldsCreated:=False; Active:=False; raise Exception.Create('I can not create persistent fields!'); end; {MF end} end; end; end; procedure TZMQueryDataSet.MemOpen; //This procedure creates dataset fields (if not created) and opens the dataset for insert/edit. //To be used for activation of memory datasets that will not be filled by sql query, //nor be loaded from stored tables. begin //First, see whether there are present persistent fields and whether they need initialization. InitializePersistentFields; FSourceData:=sdInternal; FFieldCount:=FieldDefs.Count; try //First, deal with creating dataset anew... ManageFields; //Then, open the dataset Active:=True; //If everything goes OK, then set the property accordingly. FMemoryDataSetOpened:=True; //Set mutually exclusive properties to false. FQueryExecuted:=False; FTableLoaded:=False; except FMemoryDataSetOpened:=False; Active:=False; end; end; procedure TZMQueryDataSet.MemoryDataSetOpen; begin MemOpen; end; procedure TZMQueryDataSet.FieldsFromFieldDefs; var vFieldDefsCount: Integer; //Here we create dynamic fields from predefined fielddefs. begin // with self do begin close; Fields.Clear; vFieldDefsCount := FieldDefs.Count; if (vFieldDefsCount > 0) then begin ////edgarrod71@gmail.com supposed Fields.Count is 0!!! //Set MaxIndexes count if not manually set if (MaxIndexesCount = Null) or (MaxIndexesCount < (2 * vFieldDefsCount + 3)) then MaxIndexesCount:= 2 * vFieldDefsCount + 3; //Set precision for float fields SetFloatPrecision; CreateDataset; //Creates Fields from FieldDefs /// Aquí es donde se bloquea... edgarrod71@gmail.com end; //Set display format for float fields SetFloatDisplayFormat; //Set property DynamicFieldsCreated to True FDynamicFieldsCreated:=True; FPersistentFieldsCreated:=False; end; procedure TZMQueryDataSet.FieldsFromScratch; //Here we create both fielddefs and fields. var vFieldDef:TFieldDef; vCurrentFieldSize, vMaxFieldSize, i, n:Integer; begin with self do begin if Active{=True} then Close; //Clears both fielddefs and fields.... Fields.Clear; FieldDefs.Clear; //Create new FieldDefs. for n:=0 to FFieldCount-1 do begin vFieldDef:=FieldDefs.AddFieldDef; case FSourceData of sdJanSQL:vFieldDef.Name:=FJanSQLInstance.recordsets[FRecordsetIndex].FieldNames[n]; sdSdfDataset:vFieldDef.Name:=FSdfDatasetImport.FieldDefs[n].Name; sdOtherDataset:vFieldDef.Name:=FOtherDatasetImport.FieldDefs[n].Name; end; //Determine FieldDef properties case FSourceData of sdJanSQL: begin vFieldDef.DataType:=ftString;//TODO: In procedure FieldsFromScratch add other fielddefs DataType recognition, besides ftString. vFieldDef.Required:=False; vFieldDef.Precision:=0; vFieldDef.Attributes:=[]; end; sdSdfDataset: begin vFieldDef.DataType:=FSdfDatasetImport.FieldDefs[n].DataType; vFieldDef.Required:=False; vFieldDef.Precision:=0; vFieldDef.Attributes:=[]; end; sdOtherDataset: begin vFieldDef.DataType:=FOtherDatasetImport.FieldDefs[n].DataType; vFieldDef.Required:=FOtherDatasetImport.FieldDefs[n].Required; vFieldDef.Precision:=FOtherDatasetImport.FieldDefs[n].Precision; vFieldDef.Attributes:=FOtherDatasetImport.FieldDefs[n].Attributes; end; end; //Determine FieldDef.Size property! vMaxFieldSize:=0; vCurrentFieldSize:=0; case FSourceData of sdSdfDataset: vFieldDef.Size:=FSdfDatasetImport.Fields[n].Size; sdJanSQL: begin for i:=0 to FRecordCount-1 do begin vCurrentFieldSize:=Length(FJanSQLInstance.RecordSets[FRecordsetIndex].records[i].fields[n].value); if vCurrentFieldSize>vMaxFieldSize then vMaxFieldSize:=vCurrentFieldSize; end; if vMaxFieldSize>0 then vFieldDef.Size:=vMaxFieldSize else vFieldDef.Size:=255; end; sdOtherDataset: vFieldDef.Size:=FOtherDatasetImport.Fields[n].Size; end; //Set MaxIndexes count if ((MaxIndexesCount=Null) or (MaxIndexesCount<(2*(FieldDefs.Count)+3))) then MaxIndexesCount:=(2*(FieldDefs.Count)+3); end; //Set precision for float fields SetFloatPrecision; CreateDataSet;//Creates Fields from FieldDefs //Set display format for float fields SetFloatDisplayFormat; //Set property DynamicFieldsCreated to True FDynamicFieldsCreated:=True; FPersistentFieldsCreated:=False; end; end; procedure TZMQueryDataSet.EmptySdfDataSet; begin with FSdfDatasetImport do begin if Active=False then Open; while not EOF do begin Delete; end; end; end; procedure TZMQueryDataSet.ClearSdfDataSet; begin with FSdfDatasetImport do begin if Active=True then Close; FieldDefs.Clear; Fields.Clear; end; end; procedure TZMQueryDataSet.dummyProc; begin end; function makeMethod(data, code: Pointer): TMethod; begin result.data := data; result.code := code; end; procedure TZMQueryDataSet.InsertDataFromCSV; {type TProc = procedure {(DataSet: TDataSet)} of object; const NullMethod: TMethod = (Code: nil; Data: nil);} var i:SizeInt; vFieldString:string; { DS: TBufDataSet; P: ^TRTLMethod; tmpProc: TRTLMethod;//TProc; //TDataSetNotifyEvent;} begin if not Active then Open; if not FSdfDatasetImport.Active then FSdfDatasetImport.Open; DisableControls; //// Seem not to be working because the program enters in AfterScroll event!!!! { tmpProc := TDataSetnotifyEvent(@DoAfterScroll); //// edgarrod71@gmail.com WORKAROUND!!!! } { tmpProc := @DoAfterScroll; tmpProc := TRTLMethod(@DoAfterScroll); SetMethodProp(Self, 'OnAfterScroll', NullMethod); P^ := @DoAfterScroll; tmpProc := TProc(@DoAfterScroll); tmpProc := TProc(MakeMethod(Self, P));} // DoAfterScroll := TDataSetNotifyEvent(MakeMethod(Self, @tmpProc)); { TZMQueryDataSet(Self).DoAfterScroll := nil; TMethod(DoAfterScroll).data := Pointer(Self);} // DoAfterScroll := TDataSetNotifyEvent(@dummyProc); FSdfDatasetImport.First; FAutoIncValue := 0; while not FSdfDatasetImport.EOF do begin Append; for i := 0 to Pred(FFieldCount) do begin if FieldDefs[i].DataType <> ftAutoInc then begin vFieldString := FSdfDatasetImport.Fields[i].AsString; try case Fields[i].DataType of //Fields of Float type require special transformation. ftFloat: Fields[i].Value := FormatStringToFloat(vFieldString); //Format value with appropriate decimal separator. ftInteger: begin if (vFieldString[1] in ['1'..'9','-']) then Fields[i].Value := StrToInt(vFieldString) else Fields[i].AsString := FSdfDatasetImport.Fields[i].AsString; end; else begin //Other field types. //Convert string to UTF8 {vFieldString:=AnsiToUTF8(vFieldString);} vFieldString:=ConvertEncoding(vFieldString, GuessEncoding(vFieldString),EncodingUTF8); Fields[i].Value:=vFieldString; end; end; {case} except Fields[i].Value:=FSdfDatasetImport.Fields[i].Value; end; end else { BECAUSE IT IS FTAUTOINC } begin /// edgarrod71@gmail.com if FSdfDatasetImport.Fields[i].AsInteger > FAutoIncValue then FAutoIncValue := FSdfDatasetImport.Fields[i].AsInteger; Fields[i].AsInteger := FSdfDatasetImport.Fields[i].AsInteger; end; {try} end; Post; FSdfDatasetImport.Next; end; //DoAfterScroll := TDataSetNotifyEvent(makeMethod(nil, @tmpProc)); // tmpProc := nil; if Active then begin Refresh; First; end; EnableControls; end; procedure TZMQueryDataSet.InsertDataFromJanSQL; var i,n:integer; vFieldString:string; begin if Active=False then Open; with self do begin FAutoIncValue := 0; try for i:=0 to Pred(FRecordCount) do begin Append; //Iterate columns for n:=0 to pred(FFieldCount) do begin if FieldDefs[n].DataType<>ftAutoInc then begin vFieldString:=FJanSQLInstance.RecordSets[FRecordsetIndex].records[i].fields[n].value; //Convert string to UTF8 {vFieldString:=AnsiToUTF8(vFieldString);} vFieldString:=ConvertEncoding(vFieldString, GuessEncoding(vFieldString),EncodingUTF8); //Float fields need special transformation case Fields[n].DataType of /// edgarrod71@gmail.com ftFloat: begin try //Format value with appropriate decimal separator. Fields[n].Value:=FormatStringToFloat(vFieldString); except Fields[n].AsString:=vFieldString; end; end; ftInteger: begin if (vFieldString[1] in ['1'..'9','-']) then /// must start with a valid number Fields[i].Value := StrToInt(vFieldString) else Fields[n].AsString:=vFieldString; end; //Other types of fields. else Fields[n].Value := vFieldString; end; {case} end else { BECAUSE IT IS FTAUTOINC } begin /// edgarrod71@gmail.com if FJanSQLInstance.RecordSets[FRecordsetIndex].records[i].fields[n].value > FAutoIncValue then FAutoIncValue := FJanSQLInstance.RecordSets[FRecordsetIndex].records[i].fields[n].value; Fields[i].AsInteger := FJanSQLInstance.RecordSets[FRecordsetIndex].records[i].Fields[n].value; end; end; Post; end; except raise exception.Create('error en I='+IntToStr(i)); end; if Active then begin Refresh; First; end; end; end; function TZMQueryDataSet.InspectFields:TInspectFields; //This function compares old and new dataset and detects whether fielddefs and fields should be created or not. //TInspectFields=(ifCreateFieldsFromFieldDefs, ifCreateFieldDefsAndFields, ifDoNothing, ifNewIsEmpty, ifOther); var vNewFieldNames, vOldFieldNames:String; vNewFieldDefNames, vOldFieldDefNames:String; i, vFieldDefsCount:Integer; vFieldCountMatch:Boolean; vFieldDefNamesMatch:Boolean; vNewIsEmpty:Boolean; vFieldType: TFieldType; vDelim: Char; begin //Set default values Result:=ifOther; /// vFieldCountMatch:=False; edgarrod71@gmail.com vFieldDefNamesMatch:=false; vNewIsEmpty:=False; vOldFieldNames:=''; vOldFieldDefNames:=''; vNewFieldNames:=''; vNewFieldDefNames:=''; vFieldDefsCount := FieldDefs.Count; vDelim := DELIMITERS[FFieldDelimiter]; //Iterate through Old Dataset (assumption: There cannot be fields without fielddefs). //FieldDefs for i:=0 to pred(vFieldDefsCount) do begin vOldFieldDefNames += FieldDefs[i].Name + vDelim; vFieldType := FieldDefs[i].DataType; if (vFieldType = ftAutoInc) and (FAutoIncIdx = -1) then FAutoIncIdx := I; { Question (edgarrod71@gmail.com)::: how many AutoIncrement fields must syncronize with this? I suppose it must be only one! } //Fields if (Fields.Count>0) and (Fields.Count >= (i + 1)) then vOldFieldNames += Fields[i].FieldName + vDelim; end; // end; //Iterate through New Dataset if boolean(FFieldCount) then begin //// FFieldCount>0 if FSourceData = sdInternal then vNewFieldDefNames := vOldFieldDefNames //// avoids to enter in the next loop! edgarrod71@gmail.com else for i:=0 to pred(FFieldCount) do begin case FSourceData of sdJanSQL:vNewFieldDefNames += FJanSQLInstance.recordsets[FRecordsetIndex].FieldNames[i]+ vDelim; sdSdfDataset:vNewFieldDefNames += FSdfDatasetImport.FieldDefs[i].Name+ vDelim; sdOtherDataset:vNewFieldDefNames += FOtherDatasetImport.FieldDefs[i].Name+ vDelim; //// sdInternal: vNewFieldDefNames += FieldDefs[i].Name+';'; //// Old Code, review it to eliminate end; end; vNewFieldNames := vNewFieldDefNames; /// edgarrod71@gmail.com took it out from the loop... end; //Inspect whether number of columns is same in old and new dataset vFieldCountMatch := FieldDefs.Count = FFieldCount; /// edgarrod71@gmail.com then vFieldCountMatch:=True; //Inspect whether new dataset is empty (with no columns) vNewIsEmpty := vNewFieldDefNames = ''; /// edgarrod71@gmail.com then vNewIsEmpty:=True; //Inspect whether fielddef names match vFieldDefNamesMatch := vNewFieldDefNames = vOldFieldDefNames; /// edgarrod71@gmail.com then vFieldDefNamesMatch:=True else vFieldDefNamesMatch:=False; if vNewIsEmpty then /// Modified by edgarrod71@gmail.com Result := ifNewIsEmpty else {if vNewIsEmpty=false} begin if vFieldCountMatch and vFieldDefNamesMatch then if vOldFieldNames = vNewFieldNames then Result := ifDoNothing else Result := ifCreateFieldsFromfieldDefs else { and (vFieldCountMatch=False) or (vFieldDefNamesMatch=False) then } Result := ifCreateFieldDefsAndFields; end; end; procedure TZMQueryDataSet.DoFilterRecord({var} out Acceptable: Boolean); var i, vCount:Integer; namDetail, namMaster: String; DetailField, MasterField: TField; begin //inherited behavior inherited DoFilterRecord(Acceptable); //New behavior if not Acceptable then exit; //Filter detail dataset if all conditions are met. if (not FBulkInsert) and (not DisableMasterDetailFiltration) and (Assigned(MasterFields)) and (Assigned(MasterSource)) and (FMasterDetailFiltration) and (Active) and (MasterSource.DataSet.Active) then begin vCount:=0; Filtered:=True; //Ensure dataset is filtered for i:=0 to MasterFields.Count-1 do begin //try namDetail := MasterFields.Names[i]; if namDetail <> '' then begin // if Name=Value (Detail field=Master field) pair is provided... namMaster := MasterFields.ValueFromIndex[i]; end else begin // if single name is provided for both detail and master field namMaster := FMasterFields[i]; namDetail := namMaster; end; DetailField := FieldByName(namDetail); MasterField := MasterSource.Dataset.FieldByName(namMaster); if VarSameValue(Detailfield.Value, Masterfield.Value) then inc(vCount); end; Acceptable := (vCount=MasterFields.Count); //Refresh slave datasets if not ControlsDisabled then //// edgarrod71@gmail.com DoAfterScroll; end; end; procedure TZMQueryDataSet.DoOnNewRecord; begin inherited DoOnNewRecord; {New behavior} { TODO : This is only temporary solution until bug(s) regarding ftAutoInc in TBufDataset is solved. The bug is: when new dataset is created and opened, autoincrement fields are working correctly. But, if dataset is closed and reopened, autoincrement fields are not working anymore. See bug report: http://bugs.freepascal.org/view.php?id=25628 Also, as currently implemented in TBufDataset, ftAutoInc can't be used for referential integrity in zmquerydataset.} { BUG CORRECTED!!!! edgarrod71@gmail.com } /// no estoy seguro si la segunda condición vale... if (FAutoIncIdx > -1) {and (Fields[FAutoIncIdx].DataType = ftAutoInc)} then Fields[FAutoIncIdx].AsInteger := Succ(FAutoIncValue); end; procedure TZMQueryDataSet.DoAfterScroll; var i:Integer; begin inherited DoAfterScroll; {New behavior} //For master/detail filtration if Assigned (FMasterDatasetTo) then begin for i:=0 to FMasterDatasetTo.Count-1 do begin if ((TZMQueryDataSet(FMasterDatasetTo.Items[i]).Active) and (Active) and (TZMQueryDataSet(FMasterDatasetTo.Items[i]).Fields.Count>0) and (Fields.Count>0) {and (TZMQueryDataSet(FMasterDatasetTo.Items[i]).FieldDefs.Count=TZMQueryDataSet(FMasterDatasetTo.Items[i]).Fields.Count)} ///// WHY THIS CHECK HERE? {and (FieldDefs.Count=Fields.Count)} //// why to ask? supposed the dataset is open because it has FIELDS!!! and (TZMQueryDataSet(FMasterDatasetTo.Items[i]).RecordCount>0) and (RecordCount>0) and (DisableMasterDetailFiltration=False) and (FBulkInsert=False)) then begin //Detail datasets must be refreshed in order master/detail filtration take effect. if TZMQueryDataSet(FMasterDatasetTo.Items[i]).Active then TZMQueryDataSet(FMasterDatasetTo.Items[i]).Refresh; if TZMQueryDataSet(FMasterDatasetTo.Items[i]).Active then TZMQueryDataSet(FMasterDatasetTo.Items[i]).First; end; end; end; end; procedure TZMQueryDataSet.DoBeforeEdit; begin inherited DoBeforeEdit; {New behavior} //Save OldRecord if FBulkInsert=False then UpdateFOldRecord; end; procedure TZMQueryDataSet.DoBeforeInsert; var I: integer; begin inherited DoBeforeInsert; {New behavior} //Save OldRecord if FBulkInsert=False then UpdateFOldRecord; end; procedure TZMQueryDataSet.DoBeforeDelete; var SlaveDataSet:TZMQueryDataSet; ReferentialKey:TZMReferentialKey; ReferentialKind:TZMReferentialKind; i:Integer; vFilter:String; vFiltered:Boolean; vDoReferentialDelete:Boolean; vSlaveBookmark:TBookmark; vDisableMasterDetailFiltration:Boolean; function InspectReferentialDeleteCondition: Boolean; var vDoReferentialDelete: Boolean; vCount: Integer; n: Integer; begin //Inspect whether referential conditions are met vCount:=0; vDoReferentialDelete:=False; for n:=0 to ReferentialKey.JoinedFields.Count-1 do begin try //If MasterField=SlaveField pair is provided in JoinedFields item. if SlaveDataSet.FieldByName(ReferentialKey.JoinedFields.Names[n]).AsString =FOldRecord.FieldByName(ReferentialKey.JoinedFields.ValueFromIndex[n]).AsString then Inc(vCount); except //If MasterField=SlaveField pair is not provided in JoinedFields item. if SlaveDataSet.FieldByName(ReferentialKey.JoinedFields.Names[n]).AsString =FOldRecord.FieldByName(ReferentialKey.JoinedFields[n]).AsString then Inc(vCount); end; if vCount=ReferentialKey.JoinedFields.Count then vDoReferentialDelete:=True; end; Result:=vDoReferentialDelete; end; begin inherited DoBeforeDelete; {New behavior} //Save OldRecord if FBulkInsert=False then UpdateFOldRecord; //Referential Delete if Assigned(FMasterReferentialKeys) then begin for i:=0 to FMasterReferentialKeys.Count-1 do begin ReferentialKey:=TObject(FMasterReferentialKeys[i]) as TZMReferentialKey; SlaveDataSet:=ReferentialKey.SlaveDataSet; ReferentialKind:=ReferentialKey.ReferentialKind; if ((SlaveDataSet.Active) and (Active) and (ReferentialKey.Enabled=True) and (SlaveDataSet.Fields.Count>0) and (SlaveDataSet.FieldDefs.Count=SlaveDataSet.Fields.Count) and (FieldDefs.Count>0) and (FieldDefs.Count=Fields.Count) and Assigned(ReferentialKey.JoinedFields) and (rkDelete in ReferentialKind) and (FBulkInsert=False)) then begin try //Signalize referential delete FReferentialDeleteFired:=True; SlaveDataSet.DisableControls; vSlaveBookmark:=SlaveDataSet.GetBookmark; //Enforce referential delete. self=MasterDataset try //Delete records in SlaveDataset begin DisableControls; try vFilter:=SlaveDataSet.Filter; vFiltered:=SlaveDataSet.Filtered; vDisableMasterDetailFiltration:=SlaveDataSet.DisableMasterDetailFiltration; //Disable DoFilterRecord SlaveDataSet.DisableMasterDetailFiltration:=True; SlaveDataSet.Filtered:=False; //Iterate through records in SlaveDataSet and update every record. if SlaveDataSet.Active then SlaveDataSet.Refresh; if Slavedataset.Active then SlaveDataSet.First; while not SlaveDataSet.EOF do begin vDoReferentialDelete:=InspectReferentialDeleteCondition; //Do referential delete if vDoReferentialDelete=True then begin SlaveDataSet.Delete; end else SlaveDataSet.Next; end; { TODO : To investigate why this test to bookmark validity gives wrong result and crashes the application...} { if ((SlaveDataSet.BookmarkAvailable) and (SlaveDataSet.BookmarkValid(vSlaveBookmark))) then begin SlaveDataSet.GotoBookmark(vSlaveBookmark); end; } finally //Enable DoFilterRecord SlaveDataSet.DisableMasterDetailFiltration:=vDisableMasterDetailFiltration; SlaveDataSet.Filter:=vFilter; SlaveDataSet.Filtered:=vFiltered; end; EnableControls; end; finally if SlaveDataSet.Active then SlaveDataSet.Refresh; end; finally FReferentialDeleteFired:=False; SlaveDataSet.FreeBookmark(vSlaveBookmark); SlaveDataSet.EnableControls; end; end; end; end; end; procedure TZMQueryDataSet.DoBeforePost; var MasterDataSet:TZMQueryDataSet; ReferentialKey:TZMReferentialKey; i:Integer; begin inherited DoBeforePost; { if FAutoIncIdx > -1 then FAutoIncValue := Fields[FAutoIncIdx].AsInteger;} if (FAutoIncIdx > -1) and (state = dsInsert) then FAutoIncValue := succ(FAutoIncValue); {New behavior} //Ensure that masterdatasets are not in edit state if (Assigned(FSlaveReferentialKeys)) then begin for i:=0 to FSlaveReferentialKeys.Count-1 do begin ReferentialKey:=TObject(FSlaveReferentialKeys[i]) as TZMReferentialKey; MasterDataSet:=ReferentialKey.MasterDataSet; if ( (MasterDataSet.State=dsEdit) and (MasterDataSet.Active) and (Active) and (FBulkInsert=False) and (ReferentialKey.Enabled=True) and Assigned(ReferentialKey.JoinedFields) ) then begin MasterDataSet.Post; end; end; end; FDoReferentialUpdate := State = dsEdit; { if State=dsEdit then FDoReferentialUpdate:=True else FDoReferentialUpdate:=False;} end; procedure TZMQueryDataSet.DoAfterInsert; var MasterDataSet:TZMQueryDataSet; ReferentialKey:TZMReferentialKey; ReferentialKind:TZMReferentialKind; i,n:Integer; begin inherited DoAfterInsert; //Referential Insert - self as SlaveDataset if Assigned(FSlaveReferentialKeys) then begin for i:=0 to FSlaveReferentialKeys.Count-1 do begin ReferentialKey:=TObject(FSlaveReferentialKeys[i]) as TZMReferentialKey; MasterDataSet:=ReferentialKey.MasterDataSet; ReferentialKind:=ReferentialKey.ReferentialKind; if ((MasterDataSet.Active) and (Active) and (MasterDataSet.FieldDefs.Count>0) and (MasterDataSet.FieldDefs.Count=MasterDataSet.Fields.Count) and (Fields.Count>0) and (FieldDefs.Count=Fields.Count) and (ReferentialKey.Enabled=True) and Assigned(ReferentialKey.JoinedFields) and (rkInsert in ReferentialKind) and (FBulkInsert=False)) then begin try //Signalize referential insert FReferentialInsertFired:=True; //Enforce referential insert for self as SlaveDataSet DisableControls; for n:=0 to ReferentialKey.JoinedFields.Count-1 do begin try //If MasterField=SlaveField pair is provided in JoinedFields item. FieldByName(ReferentialKey.JoinedFields.Names[n]).Value:=MasterDataSet.FieldByName(ReferentialKey.JoinedFields.ValueFromIndex[n]).Value; except //If MasterField=SlaveField pair is not provided in JoinedFields item. FieldByName(ReferentialKey.JoinedFields[n]).Value:=MasterDataSet.FieldByName(ReferentialKey.JoinedFields[n]).Value; end; end; finally FReferentialInsertFired:=False; EnableControls; end; end; end; end; //Refresh slave datasets if not boolean(ControlsDisabled) then //// edgarrod71@gmail.com even in DisabledControls put it called Scroll!!! DoAfterScroll; end; procedure TZMQueryDataSet.DoAfterPost; var {MasterDataSet:TZMQueryDataSet;} SlaveDataSet:TZMQueryDataSet; ReferentialKey:TZMReferentialKey; ReferentialKind:TZMReferentialKind; i,n:Integer; vFilter:String; vFiltered:Boolean; vDisableMasterDetailFiltration:Boolean; vDoReferentialUpdate:Boolean; vSlaveBookmark:TBookmark; function InspectReferentialUpdateCondition: Boolean; var vDoReferentialUpdate: Boolean; vCount: Integer; j:Integer; begin //Inspect whether referential conditions are met vCount:=0; vDoReferentialUpdate:=False; for j:=0 to ReferentialKey.JoinedFields.Count-1 do begin try //If MasterField=SlaveField pair is provided in JoinedFields item. if SlaveDataSet.FieldByName(ReferentialKey.JoinedFields.Names[j]).AsString =FOldRecord.FieldByName(ReferentialKey.JoinedFields.ValueFromIndex[j]).AsString then Inc(vCount); except //If MasterField=SlaveField pair is not provided in JoinedFields item. if SlaveDataSet.FieldByName(ReferentialKey.JoinedFields.Names[j]).AsString =FOldRecord.FieldByName(ReferentialKey.JoinedFields[j]).AsString then Inc(vCount); end; if vCount=ReferentialKey.JoinedFields.Count then vDoReferentialUpdate:=True; end; Result:=vDoReferentialUpdate; end; begin inherited DoAfterPost; {New behavior} //Persistent save if (FPersistentSave{=True}) and (FBulkInsert=False) then if (FTableName<>null) then SaveToTable {MF begin} // was: else ShowMessage('Dataset can not be saved because TableName property is not set'); else raise Exception.Create('Dataset can not be saved because TableName property is not set'); {MF end} if FDoReferentialUpdate=False then exit; //Referential Update; self as Master Dataset if Assigned(FMasterReferentialKeys) then begin for i:=0 to FMasterReferentialKeys.Count-1 do begin ReferentialKey:=TObject(FMasterReferentialKeys[i]) as TZMReferentialKey; SlaveDataSet:=ReferentialKey.SlaveDataSet; ReferentialKind:=ReferentialKey.ReferentialKind; if ((SlaveDataSet.Active) and (Active) and (SlaveDataSet.FieldDefs.Count>0) and (SlaveDataSet.FieldDefs.Count=SlaveDataSet.Fields.Count) and (Fields.Count>0) and (FieldDefs.Count=Fields.Count) and (ReferentialKey.Enabled=True) and Assigned(ReferentialKey.JoinedFields) and (rkUpdate in ReferentialKind) and (FBulkInsert=False)) then begin try //Signalize referential update FReferentialUpdateFired:=True; //Update records in SlaveDataset SlaveDataSet.DisableControls; vSlaveBookmark:=SlaveDataSet.GetBookmark; begin try vFilter:=SlaveDataSet.Filter; vFiltered:=SlaveDataSet.Filtered; vDisableMasterDetailFiltration:=SlaveDataSet.DisableMasterDetailFiltration; //Disable DoFilterRecord SlaveDataSet.DisableMasterDetailFiltration:=True; SlaveDataSet.Filtered:=False; //Iterate through records in SlaveDataSet and update every record. if SlaveDataSet.Active then SlaveDataSet.Refresh; if SlaveDataSet.Active then SlaveDataSet.First; while not SlaveDataSet.EOF do begin vDoReferentialUpdate:=InspectReferentialUpdateCondition; //Do referential update if vDoReferentialUpdate=True then begin SlaveDataSet.Edit; //Enforce referential update for SlaveDataSet for n:=0 to ReferentialKey.JoinedFields.Count-1 do begin try //If MasterField=SlaveField pair is provided in JoinedFields item. SlaveDataSet.FieldByName(ReferentialKey.JoinedFields.Names[n]).Value :=FieldByName(ReferentialKey.JoinedFields.ValueFromIndex[n]).Value; except //If MasterField=SlaveField pair is not provided in JoinedFields item. SlaveDataSet.FieldByName(ReferentialKey.JoinedFields[n]).Value :=FieldByName(ReferentialKey.JoinedFields[n]).Value; end; end; SlaveDataSet.Post; end; SlaveDataSet.Next; end; try if ((SlaveDataSet.BookmarkAvailable) and (SlaveDataSet.BookmarkValid(vSlaveBookmark))) then SlaveDataSet.GotoBookmark(vSlaveBookmark); except end; finally //Enable DoFilterRecord SlaveDataSet.DisableMasterDetailFiltration:=vDisableMasterDetailFiltration; SlaveDataSet.Filter:=vFilter; SlaveDataSet.Filtered:=vFiltered; end; end; finally FReferentialUpdateFired:=False; if SlaveDataSet.Active then SlaveDataSet.Refresh; SlaveDataSet.FreeBookmark(vSlaveBookmark); SlaveDataSet.EnableControls; end; end; end; end; //Refresh slave datasets if not ControlsDisabled then DoAfterScroll; end; procedure TZMQueryDataSet.DoAfterDelete; begin inherited DoAfterDelete; {New behavior} //Persistent save if ((FPersistentSave{=True}) and (FBulkInsert=False)) then begin if (FTableName<>null) then SaveToTable {MF begin} // was: else ShowMessage('Dataset can not be saved because TableName property is not set'); else raise Exception.Create('Dataset can not be saved because TableName property is not set'); {MF end} end; //Refresh slave datasets if not ControlsDisabled then //// edgarrod71@gmail.com DoAfterScroll; end; procedure TZMQueryDataSet.InternalRefresh; begin //Do nothing. TBufDataSet's InternalRefresh does troubles. //It seems that what in TDataSet's Refresh method is implemented is quite enough for ZMQueryDataset. { inherited InternalRefresh; } end; procedure TZMQueryDataSet.DoAfterClose; begin inherited DoAfterClose; //Deal with mutually exclusive properties FTableLoaded := False; FQueryExecuted := False; FMemoryDataSetOpened := False; //Reset autoincrement counter FAutoIncValue:=0; end; procedure TZMQueryDataSet.QueryExecute; begin try DisableControls; //First, see whether there are present persistent fields and whether they need initialization. InitializePersistentFields; try DoQueryExecute; //If everything goes OK, then set the property accordingly. FQueryExecuted := True; //Set mutually exclusive properties to false. FTableLoaded := False; FMemoryDataSetOpened := False; except FQueryExecuted := False; Active := False; end; finally //Refresh self if Active then refresh; EnableControls end; end; procedure TZMQueryDataSet.PrepareQuery; {This is temporary simple solution of passing parameters to query SQL string before execution} var i:Integer; begin FOriginalSQL:=''; FPreparedSQL:=''; for i:=0 to FSQL.Count-1 do begin FOriginalSQL:=FOriginalSQL+' '+FSQL.Strings[i]; end; FPreparedSQL:=FOriginalSQL; if (Assigned(Parameters) and (Parameters.Count>0)) then begin for i:=0 to Parameters.Count-1 do begin //Apply parameters by name FPreparedSQL:=AnsiReplaceText(FPreparedSQL,':'+Parameters[i].Name,Parameters[i].Value);//There must be better way... end; end; {ShowMessage('Prepared query:'+FPreparedSQL);} end; constructor TZMQueryDataSet.Create(AOwner: TComponent); begin inherited Create(AOwner); { //JanSQL instance FJanSQLInstance:=TJanSQL.Create; } FAutoIncValue := 0; /// edgarrod71@gmail.com FAutoIncIdx := -1; /// edgarrod71@gmail.com -1 means no AutoIncIdx; >0 means there is and position of it FTableFile := nil; FFieldsLoaded := false; //SQL FSQL := TStringList.Create; //Master/detail filtration FMasterFields:=TStringList.Create; FMasterDataSetTo:=TList.Create; //Referential integrity FMasterReferentialKeys:=TList.Create; FSlaveReferentialKeys:=TList.Create; //Import/export FSdfDatasetImport:=TSdfDataset.Create(nil); FCSVExporterExport:=TCSVExporter.Create(nil); //Parameters FParameters:=TParams.Create; //FOldRecord FOldRecord:={$IFDEF ZMBufDataset} TZMBufDataSet{$ELSE}TBufDataSet{$ENDIF}.Create(nil); end; destructor TZMQueryDataSet.Destroy; begin if Assigned(FTableFile) then FreeAndNil(FTableFile); //Import/Export if FSdfDatasetImport.Active{=True} then FSdfDatasetImport.Close; FreeAndNil(FSdfDatasetImport); FreeAndNil(FCSVExporterExport); //FOldRecord FreeAndNil(FOldRecord); //Parameters FreeAndNil(FParameters); //SQL FreeAndNil(FSQL); //Master/detail FreeAndNil(FMasterFields); FreeAndNil(FMasterDataSetTo); //Referential integrity FreeAndNil(FMasterReferentialKeys); FreeAndNil(FSlaveReferentialKeys); //JanSQL if FRecordsetIndex>0 then FJanSQLInstance.ReleaseRecordset(FRecordsetIndex); if Assigned(FJanSQLInstance) then FreeAndNil(FJanSQLInstance); //inherited inherited Destroy; end; procedure TZMQueryDataSet.SetFloatDisplayFormat; var vFD: TCollectionItem; begin //If FloatDisplayFormat property is set, then take it... if (Assigned(FZMConnection) and (FZMConnection.FloatDisplayFormat<>'') and (FZMConnection.FloatDisplayFormat<>Null)) then begin //Set display format for Float type for vFD in FieldDefs do //// edgarrod71@gmail.com if ((TFieldDef(vFD).DataType=ftFloat) and ((Fields[vFD.Index] as TFloatField).DisplayFormat='')) //Manually set property value has precendance than property set in ZMConnection. then begin (Fields[vFD.Index] as TFloatField).DisplayFormat := FZMConnection.FloatDisplayFormat; end; end; end; procedure TZMQueryDataSet.SetFloatPrecision; var vFD: TCollectionItem; begin //If FloatPrecision property is set, then take it... if (Assigned(FZMConnection) and (FZMConnection.FloatPrecision<>0) and (FZMConnection.FloatPrecision <> Null)) then //Set precision for Float type for vFD in FieldDefs do /// edgarrod71@gmail.com if (TFieldDef(vFD).DataType=ftFloat) and (TFieldDef(vFD).Precision = 0) then //Manually set property value has precendance than property set in ZMConnection. TFieldDef(vFD).Precision := FZMConnection.FloatPrecision; end; function TZMQueryDataSet.ZMInitializePersistentField(AOwner: TComponent; AFieldDef: TFieldDef; AOldPersistentField:TField): TField; Var TheNewPeristentField : TFieldClass; vName:String; begin {TheNewPeristentField:=GetFieldClass(AFieldDef.DataType); if TheNewPeristentField=Nil then DatabaseErrorFmt(SUnknownFieldType,[FName]); Result:=TheNewPeristentField.Create(AOwner); } TheNewPeristentField:=GetFieldClass(AFieldDef.DataType); {TheNewPeristentField:=AOldPersistentField.ClassType;} Result:=TheNewPeristentField.Create(AOwner); Try //Copy all properties from old persistent field. Result.Size:={AFieldDef.Size;}AOldPersistentField.Size; Result.Required:={AFieldDef.Required;}AOldPersistentField.Required; Result.FieldName:={AFieldDef.Name;}AOldPersistentField.Name; Result.DisplayLabel:={AFieldDef.DisplayName;}AOldPersistentField.DisplayName; Result.{SetFieldType(AFieldDef.DataType);}SetFieldType(AOldPersistentField.DataType); Result.ReadOnly:= {(faReadOnly in AFieldDef.Attributes);}AOldPersistentField.ReadOnly; //Other properties Result.Required:=AOldPersistentField.Required; {Result.DisplayName:=AOldPersistentField.DisplayName;} Result.Alignment:=AOldPersistentField.Alignment; Result.AttributeSet:=AOldPersistentField.AttributeSet; Result.Calculated:=AOldPersistentField.Calculated; Result.ConstraintErrorMessage:=AOldPersistentField.ConstraintErrorMessage; Result.CustomConstraint:=AOldPersistentField.CustomConstraint; {Result.DataSet:=AOldPersistentField.DataSet;} Result.DefaultExpression:=AOldPersistentField.DefaultExpression; Result.DisplayWidth:=AOldPersistentField.DisplayWidth; Result.EditMask:=AOldPersistentField.EditMask; Result.FieldKind:=AOldPersistentField.FieldKind; Result.ImportedConstraint:=AOldPersistentField.ImportedConstraint; Result.Index:=AOldPersistentField.Index; Result.KeyFields:=AOldPersistentField.KeyFields; Result.Lookup:=AOldPersistentField.Lookup; Result.LookupCache:=AOldPersistentField.LookupCache; Result.LookupDataSet:=AOldPersistentField.LookupDataSet; Result.LookupKeyFields:=AOldPersistentField.LookupKeyFields; Result.LookupResultField:=AOldPersistentField.LookupResultField; {Result.IsBlob:=AOldPersistentField.IsBlob;} Result.OnChange:=AOldPersistentField.OnChange; Result.OnGetText:=AOldPersistentField.OnGetText; Result.OnSetText:=AOldPersistentField.OnSetText; Result.OnValidate:=AOldPersistentField.OnValidate; Result.Origin:=AOldPersistentField.Origin; Result.ProviderFlags:=AOldPersistentField.ProviderFlags; {Result.Text:=AOldPersistentField.Text;} Result.ValidChars:=AOldPersistentField.ValidChars; Result.Tag:=AOldPersistentField.Tag; Result.Visible:=AOldPersistentField.Visible; Result.DesignInfo:=AOldPersistentField.DesignInfo; { Result.Dataset:=self; } If (Result is TFloatField) then TFloatField(Result).Precision:={AFieldDef.Precision;}TFloatField(AOldPersistentField).Precision; if (Result is TBCDField) then TBCDField(Result).Precision:={AFieldDef.Precision;}TBCDField(AOldPersistentField).Precision; if (Result is TFmtBCDField) then TFmtBCDField(Result).Precision:={AFieldDef.Precision;}TFmtBCDField(AOldPersistentField).Precision; //Set Name of the new persistent fields and delete old persistent field. vName:=AOldPersistentField.Name; FreeAndNil(AOldPersistentField); Result.Name:=vName; except FreeAndNil(Result); Raise; end; end; procedure TZMQueryDataSet.InitializePersistentFields; var i:Integer; vPersistentFields:Boolean; vFieldNoPresent:Boolean; vFieldsCount, vFieldDefsCount: Integer; begin //Initialize persistent fields //First detetect whether persistent fields are loaded from .lfm vPersistentFields:=False; vFieldNoPresent:=True; vFieldsCount := Fields.Count; //// remember to reassign to the vFieldDefsCount := FieldDefs.Count; //// next IF if boolean(vFieldDefsCount) and (vFieldsCount = vFieldDefsCount) then begin // if ((Fields.Count=FieldDefs.Count) and (FieldDefs.Count>0)) then begin vPersistentFields:=True; for i:=0 to pred(vFieldDefsCount) do begin if FieldDefs[i].Name <> Fields[i].FieldName then vPersistentFields:=False; if Fields[i].FieldNo=0 then vFieldNoPresent:=False; end; end; /////// if ((vPersistentFields{=True}) and (vFieldNoPresent=False)) then vPersistentFieldsNeedInitialization:=True; //If there are persistent fields and need recreation, then recreate them. ////// if (vPersistentFieldsNeedInitialization{=True}) then begin if vPersistentFields{=True} and (vFieldNoPresent=False) then begin SetDefaultFields(False); for i := 0 to pred(vFieldDefsCount) do ZMInitializePersistentField(self.Owner, FieldDefs[i], self.FindField(FieldDefs[i].Name)); BindFields(True); end; end; procedure TZMQueryDataSet.ResetAutoInc(pStart: SizeInt); begin FAutoIncValue:=pStart; end; function TZMQueryDataSet.LoadTableFields: boolean; //// edgarrod71@gmail.com var S, fName, fField: string; P: PChar; procedure FillFieldDefs; var vFieldDef: TFieldDef; vDelim: Char; begin if FieldDefs.Count > 0 then FieldDefs.Clear; vDelim := DELIMITERS[FFieldDelimiter]; P := @S[1]; if P <> '' then repeat /// This gets the Fields from File and updates FieldDefs... fField := ''; repeat fField += P^; inc(P); until P^ in [#0, #10, #13, vDelim]; if P^ = vDelim then inc(P); vFieldDef := FieldDefs.AddFieldDef; vFieldDef.Name := fField; vFieldDef.DataType:=ftString; vFieldDef.Size := 1024; vFieldDef.Required:=False; vFieldDef.Precision:=0; vFieldDef.Attributes:=[]; until (P^ in [#0, #10, #13]){ or (P = '')}; end; begin Result := false; if FileName <> '' then fName := FileName else if TableName <> '' then fName := TableName + '.csv'; if fName <> '' then begin if Assigned(FTableFile) then FreeAndNil(FTableFile); try FTableFile := TFileStream.Create(fName, fmOpenReadWrite); SetLength(S, FTableFile.Size); FTableFile.Read(S[1], FTableFile.Size); FillFieldDefs; CreateDynamicFieldsFromFieldDefs; /// this ManageFields finally if Active then //// it must be closed, but not sure if here we can close it!!! Close; Result := true; FFieldsLoaded := true; end; end; end; procedure TZMQueryDataSet.LoadLastRecord; //// edgarrod71@gmail.com var I: integer; P: PChar; begin if not FFieldsLoaded then LoadTableFields; I := FTableFile.Seek(0, soFromEnd); /// se supone que FTableFile está abierto /// result no va aquí, se supone que se cargue en un registro... // Result := ''; AQUI VOY!!! // P := @S[I]; repeat // Result := (P-1)^ + Result; //// for this, file must have a #10 at the end of file dec(P); until ((P-1)^ in [#10, #13]); end; function TZMQueryDataSet.AddRecord(const Values: array of const; pAutoIncPos: Integer): boolean; //// edgarrod71@gmail.com var i: integer; value: string; begin Result := false; if not FFieldsLoaded and Active then try AppendRecord(Values); finally result := true; end else begin if not FFieldsLoaded then LoadTableFields; if (length(Values) = FieldDefs.Count) then begin { Inserta el último registro } // TO-DO: if pAutoIncPos > -1 then check the position, the LastRecord and AutoInc-it! // T := GetLastRecord; /// I must do something with this... /// Hay que cargar el último registro!!! no recuerdo para qué value := ''; for i := 0 to High(Values) do begin case Values[i].vType of vtWideString: value := WideString(Values[i].VWideString); vtAnsiString: value := AnsiString(Values[i].vAnsiString); vtExtended: value := floatToStr(Values[i].vExtended^); vtInteger: value := IntToStr(Values[i].vInteger); vtPChar: value := Values[i].vPChar^; vtString: value := Values[i].vString^; end; if i <> High(Values) then value += DELIMITERS[FFieldDelimiter] else value += #10; Result := boolean(FTableFile.Write(PChar(value)^, length(value))); end; end else raise Exception.Create('Fields Count Differ from Table' + FTableFile.FileName + '!'); end; end; procedure TZMQueryDataSet.Insert; //// edgarrod71@gmail.com begin case State of dsBrowse: inherited Insert; dsEdit, dsInsert: Post; dsInactive: begin if FFieldsLoaded then MemOpen; inherited Insert; end; end; end; procedure TZMQueryDataSet.Post; //// edgarrod71@gmail.com var I, FC: integer; AOC: array of TVarRec; VR: ^TVarRec; begin if FFieldsLoaded then try FC := Fields.Count; SetLength(AOC, FC); VR := @AOC[0]; for I := 0 to FC - 1 do begin VR[I].vType := vtWideString; case VR[I].vType of /// edgarrod71@gmail.com Possible items (just in case) vtWideString: WideString(VR[I].VWideString) := Fields[i].AsWideString; vtInteger: VR[I].VInteger := Fields[I].AsInteger; // vtAnsiString: AnsiString(VR[I].VAnsiString) := Fields[i].AsAnsiString; vtString: String(VR[I].VString) := Fields[I].AsString; end; end; AddRecord(AOC); finally Close; end else if Active then inherited post; end; initialization RegisterClasses ( [{ ftUnknown} Tfield, { ftString} TStringField, { ftSmallint} TSmallIntField, { ftInteger} TLongintField, { ftWord} TWordField, { ftBoolean} TBooleanField, { ftFloat} TFloatField, { ftCurrency} TCurrencyField, { ftBCD} TBCDField, { ftDate} TDateField, { ftTime} TTimeField, { ftDateTime} TDateTimeField, { ftBytes} TBytesField, { ftVarBytes} TVarBytesField, { ftAutoInc} TAutoIncField, { ftBlob} TBlobField, { ftMemo} TMemoField, { ftGraphic} TGraphicField, { ftFmtMemo} TBlobField, { ftParadoxOle} TBlobField, { ftDBaseOle} TBlobField, { ftTypedBinary} TBlobField, { ftFixedChar} TStringField, { ftWideString} TWideStringField, { ftLargeint} TLargeIntField, { ftOraBlob} TBlobField, { ftOraClob} TMemoField, { ftVariant} TVariantField, { ftGuid} TGuidField, { ftFMTBcd} TFMTBCDField, { ftFixedWideString} TWideStringField, { ftWideMemo} TWideMemoField ]); end.