1 {*********************************************************}
3 { Zeos Database Objects }
4 { Abstract Read/Write Dataset component }
6 { Originally written by Sergey Seroukhov }
8 {*********************************************************}
10 {@********************************************************}
11 { Copyright (c) 1999-2012 Zeos Development Group }
13 { License Agreement: }
15 { This library is distributed in the hope that it will be }
16 { useful, but WITHOUT ANY WARRANTY; without even the }
17 { implied warranty of MERCHANTABILITY or FITNESS FOR }
18 { A PARTICULAR PURPOSE. See the GNU Lesser General }
19 { Public License for more details. }
21 { The source code of the ZEOS Libraries and packages are }
22 { distributed under the Library GNU General Public }
23 { License (see the file COPYING / COPYING.ZEOS) }
24 { with the following modification: }
25 { As a special exception, the copyright holders of this }
26 { library give you permission to link this library with }
27 { independent modules to produce an executable, }
28 { regardless of the license terms of these independent }
29 { modules, and to copy and distribute the resulting }
30 { executable under terms of your choice, provided that }
31 { you also meet, for each linked independent module, }
32 { the terms and conditions of the license of that module. }
33 { An independent module is a module which is not derived }
34 { from or based on this library. If you modify this }
35 { library, you may extend this exception to your version }
36 { of the library, but you are not obligated to do so. }
37 { If you do not wish to do so, delete this exception }
38 { statement from your version. }
41 { The project web site is located on: }
42 { http://zeos.firmos.at (FORUM) }
43 { http://sourceforge.net/p/zeoslib/tickets/ (BUGTRACKER)}
44 { svn://svn.code.sf.net/p/zeoslib/code-0/trunk (SVN) }
46 { http://www.sourceforge.net/projects/zeoslib. }
49 { Zeos Development Group. }
50 {********************************************************@}
52 unit ZAbstractDataset;
60 SysUtils, Classes, {$IFDEF MSEgui}mdb, mclasses{$ELSE}DB{$ENDIF},
61 ZSqlUpdate, ZDbcIntfs, ZVariant, ZDbcCache, ZDbcCachedResultSet,
62 ZAbstractRODataset, ZCompatibility, ZSequence;
65 {$IFDEF oldFPC} // added in 2006, probably pre 2.2.4
66 TUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApplied);
69 {** Update Event type. }
70 TUpdateRecordEvent = procedure(DataSet: TDataSet; UpdateKind: TUpdateKind;
71 var UpdateAction: TUpdateAction) of object;
73 {** Defines update modes for the resultsets. }
74 TZUpdateMode = (umUpdateChanged, umUpdateAll);
76 {** Defines where form types for resultsets. }
77 TZWhereMode = (wmWhereKeyOnly, wmWhereAll);
80 Abstract dataset component which supports read/write access and
83 TZAbstractDataset = class(TZAbstractRODataset)
85 FCachedUpdatesBeforeMasterUpdate: Boolean;
86 FCachedUpdates: Boolean;
87 FUpdateObject: TZUpdateSQL;
88 FCachedResultSet: IZCachedResultSet;
89 FCachedResolver: IZCachedResolver;
90 FOnApplyUpdateError: TDataSetErrorEvent;
91 FOnUpdateRecord: TUpdateRecordEvent;
92 FUpdateMode: TZUpdateMode;
93 FWhereMode: TZWhereMode;
94 FSequence: TZSequence;
95 FSequenceField: string;
97 FBeforeApplyUpdates: TNotifyEvent; {bangfauzan addition}
98 FAfterApplyUpdates: TNotifyEvent; {bangfauzan addition}
99 FDetailDataSets: TList;
100 FDetailCachedUpdates: array of Boolean;
102 function GetUpdatesPending: Boolean;
103 procedure SetUpdateObject(Value: TZUpdateSQL);
104 procedure SetCachedUpdates(Value: Boolean);
105 procedure SetWhereMode(Value: TZWhereMode);
106 procedure SetUpdateMode(Value: TZUpdateMode);
109 property CachedResultSet: IZCachedResultSet read FCachedResultSet
110 write FCachedResultSet;
111 property CachedResolver: IZCachedResolver read FCachedResolver
112 write FCachedResolver;
113 property UpdateMode: TZUpdateMode read FUpdateMode write SetUpdateMode
114 default umUpdateChanged;
115 property WhereMode: TZWhereMode read FWhereMode write SetWhereMode
116 default wmWhereKeyOnly;
118 procedure InternalClose; override;
119 procedure InternalEdit; override;
120 procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override;
121 procedure InternalPost; override;
122 procedure InternalDelete; override;
123 procedure InternalUpdate;
124 procedure InternalCancel; override;
126 procedure DOBeforeApplyUpdates; {bangfauzan addition}
127 procedure DOAfterApplyUpdates; {bangfauzan addition}
130 function CreateStatement(const SQL: string; Properties: TStrings):
131 IZPreparedStatement; override;
132 function CreateResultSet(const SQL: string; MaxRows: Integer):
133 IZResultSet; override;
134 procedure Notification(AComponent: TComponent; Operation: TOperation);
137 {$IFDEF WITH_IPROVIDER}
138 function PSUpdateRecord(UpdateKind: TUpdateKind;
139 Delta: TDataSet): Boolean; override;
141 procedure RegisterDetailDataSet(Value: TZAbstractDataset; CachedUpdates: Boolean);
142 procedure DisposeCachedUpdates;
144 constructor Create(AOwner: TComponent); override;
145 destructor Destroy; override;
147 procedure ApplyUpdates;
148 procedure CommitUpdates;
149 procedure CancelUpdates;
150 procedure RevertRecord;
151 procedure RefreshCurrentRow(const RefreshDetails:Boolean); //FOS+ 07112006
153 procedure EmptyDataSet; {bangfauzan addition}
156 property UpdatesPending: Boolean read GetUpdatesPending;
157 property Sequence: TZSequence read FSequence write FSequence;
158 property SequenceField: string read FSequenceField write FSequenceField;
161 property UpdateObject: TZUpdateSQL read FUpdateObject write SetUpdateObject;
162 property CachedUpdates: Boolean read FCachedUpdates write SetCachedUpdates
165 property OnApplyUpdateError: TDataSetErrorEvent read FOnApplyUpdateError
166 write FOnApplyUpdateError;
167 property OnUpdateRecord: TUpdateRecordEvent read FOnUpdateRecord
168 write FOnUpdateRecord;
170 property BeforeApplyUpdates: TNotifyEvent read FBeforeApplyUpdates
171 write FBeforeApplyUpdates; {bangfauzan addition}
172 property AfterApplyUpdates: TNotifyEvent read FAfterApplyUpdates
173 write FAfterApplyUpdates; {bangfauzan addition}
177 property BeforeInsert;
178 property AfterInsert;
183 property BeforeCancel;
184 property AfterCancel;
185 property BeforeDelete;
186 property AfterDelete;
187 property OnDeleteError;
188 property OnEditError;
189 property OnPostError;
190 property OnNewRecord;
195 uses Math, ZMessages, ZDatasetUtils;
197 { TZAbstractDataset }
200 Constructs this object and assignes the mail properties.
201 @param AOwner a component owner.
203 constructor TZAbstractDataset.Create(AOwner: TComponent);
205 inherited Create(AOwner);
207 FWhereMode := wmWhereKeyOnly;
208 FUpdateMode := umUpdateChanged;
210 FDetailDataSets := TList.Create;
214 Destroys this object and cleanups the memory.
216 destructor TZAbstractDataset.Destroy;
218 FreeAndNil(FDetailDataSets);
219 if Assigned(FUpdateObject) then
221 FUpdateObject.DataSet := nil;
222 SetUpdateObject(nil);
228 Sets a new UpdateSQL object.
229 @param Value a new UpdateSQL object.
231 procedure TZAbstractDataset.SetUpdateObject(Value: TZUpdateSQL);
233 if FUpdateObject <> Value then
235 if Assigned(FUpdateObject) then
236 FUpdateObject.RemoveFreeNotification(Self);
237 FUpdateObject := Value;
238 if Assigned(FUpdateObject) then
239 FUpdateObject.FreeNotification(Self);
240 if Assigned(FUpdateObject) then
241 FUpdateObject.DataSet := Self;
242 if Active and (CachedResultSet <> nil) then
244 if FUpdateObject <> nil then
245 CachedResultSet.SetResolver(FUpdateObject)
247 CachedResultSet.SetResolver(CachedResolver);
253 Sets a new CachedUpdates property value.
254 @param Value a new CachedUpdates value.
256 procedure TZAbstractDataset.SetCachedUpdates(Value: Boolean);
258 if FCachedUpdates <> Value then
260 FCachedUpdates := Value;
261 if Active and (CachedResultSet <> nil) then
262 CachedResultSet.SetCachedUpdates(Value);
267 Sets a new UpdateMode property value.
268 @param Value a new UpdateMode value.
270 procedure TZAbstractDataset.SetUpdateMode(Value: TZUpdateMode);
272 if FUpdateMode <> Value then
274 FUpdateMode := Value;
281 Sets a new WhereMode property value.
282 @param Value a new WhereMode value.
284 procedure TZAbstractDataset.SetWhereMode(Value: TZWhereMode);
286 if FWhereMode <> Value then
295 Creates a DBC statement for the query.
296 @param SQL an SQL query.
297 @param Properties a statement specific properties.
298 @returns a created DBC statement.
300 function TZAbstractDataset.CreateStatement(
301 const SQL: string; Properties: TStrings): IZPreparedStatement;
305 Temp := TStringList.Create;
307 Temp.AddStrings(Properties);
309 { Sets update mode property.}
311 umUpdateAll: Temp.Values['update'] := 'all';
312 umUpdateChanged: Temp.Values['update'] := 'changed';
314 { Sets where mode property. }
316 wmWhereAll: Temp.Values['where'] := 'all';
317 wmWhereKeyOnly: Temp.Values['where'] := 'keyonly';
320 Result := inherited CreateStatement(SQL, Temp);
327 Creates a DBC resultset for the query.
328 @param SQL an SQL query.
329 @param MaxRows a maximum rows number (-1 for all).
330 @returns a created DBC resultset.
332 function TZAbstractDataset.CreateResultSet(const SQL: string; MaxRows: Integer):
335 Result := inherited CreateResultSet(SQL, MaxRows);
337 if not Assigned(Result) then
340 if Result.QueryInterface(IZCachedResultSet, FCachedResultSet) = 0 then
342 CachedResultSet := Result as IZCachedResultSet;
343 CachedResolver := CachedResultSet.GetResolver;
344 CachedResultSet.SetCachedUpdates(CachedUpdates);
345 if FUpdateObject <> nil then
346 CachedResultSet.SetResolver(FUpdateObject);
351 Performs internal query closing.
353 procedure TZAbstractDataset.InternalClose;
355 inherited InternalClose;
357 if not DoNotCloseResultset then
359 if Assigned(CachedResultSet) then
360 CachedResultSet.Close;
361 CachedResultSet := nil;
362 CachedResolver := nil;
367 Performs an internal action before switch into edit mode.
369 procedure TZAbstractDataset.InternalEdit;
374 Performs an internal record updates.
379 procedure TZAbstractDataset.InternalUpdate;
382 RowBuffer: PZRowBuffer;
384 if (CachedResultSet <> nil) and GetActiveBuffer(RowBuffer) then
386 RowNo := Integer(CurrentRows[CurrentRow - 1]);
387 CachedResultSet.MoveAbsolute(RowNo);
388 RowAccessor.RowBuffer := RowBuffer;
389 PostToResultSet(CachedResultSet, FieldsLookupTable, Fields, RowAccessor);
391 CachedResultSet.UpdateRow;
392 except on E: EZSQLThrowable do
393 raise EZDatabaseError.CreateFromException(E);
397 if not FilterRow(RowNo) then
399 CurrentRows.Delete(CurrentRow - 1);
400 CurrentRow := Min(CurrentRows.Count, CurrentRow);
409 Performs an internal adding a new record.
410 @param Buffer a buffer of the new adding record.
411 @param Append <code>True</code> if record should be added to the end
417 procedure TZAbstractDataset.InternalAddRecord(Buffer: Pointer; Append: Boolean);
420 RowBuffer: PZRowBuffer;
422 if not GetActiveBuffer(RowBuffer) or (RowBuffer <> Buffer) then
423 raise EZDatabaseError.Create(SInternalError);
428 if CachedResultSet <> nil then
430 CachedResultSet.MoveToInsertRow;
431 RowAccessor.RowBuffer := RowBuffer;
432 PostToResultSet(CachedResultSet, FieldsLookupTable, Fields, RowAccessor);
434 CachedResultSet.InsertRow;
435 except on E: EZSQLThrowable do
436 raise EZDatabaseError.CreateFromException(E);
438 RowNo := CachedResultSet.GetRow;
439 FetchCount := FetchCount + 1;
442 if FilterRow(RowNo) then
446 CurrentRows.Add(Pointer(RowNo));
447 CurrentRow := CurrentRows.Count;
451 CurrentRow := Max(CurrentRow, 1);
452 CurrentRows.Insert(CurrentRow - 1, Pointer(RowNo));
463 Performs an internal post updates.
468 procedure TZAbstractDataset.InternalPost;
470 RowBuffer: PZRowBuffer;
471 {$IFDEF WITH_TBOOKMARK}
478 if (FSequenceField <> '') and Assigned(FSequence) then
480 if FieldByName(FSequenceField).IsNull then
481 FieldByName(FSequenceField).Value := FSequence.GetNextValue;
484 //inherited; //AVZ - Firebird defaults come through when this is commented out
487 if not GetActiveBuffer(RowBuffer) then
488 raise EZDatabaseError.Create(SInternalError);
490 Connection.ShowSqlHourGlass;
492 //revert Master Detail updates makes it possible to update
493 // with ForeignKey contraints
494 if Assigned(MasterLink.DataSet) then
495 if (TDataSet(MasterLink.DataSet) is TZAbstractDataset) then
496 if ( doUpdateMasterFirst in TZAbstractDataset(MasterLink.DataSet).Options )
497 or ( doUpdateMasterFirst in Options ) then
498 begin //This is an detail-table
499 FCachedUpdatesBeforeMasterUpdate := CachedUpdates; //buffer old value
500 if not(CachedUpdates) then
501 CachedUpdates := True; //Execute without writing
502 TZAbstractDataset(MasterLink.DataSet).RegisterDetailDataSet(Self,
503 TZAbstractDataset(MasterLink.DataSet).CachedUpdates);
506 if State = dsInsert then
507 InternalAddRecord(RowBuffer, False)
511 // Apply Detail updates now
512 if FDetailDataSets.Count > 0 then
513 for i := 0 to FDetailDataSets.Count -1 do
514 if (TDataSet(FDetailDataSets.Items[i]) is TZAbstractDataset) then
516 if not (Self.FDetailCachedUpdates[I]) then
517 TZAbstractDataset(TDataSet(FDetailDataSets.Items[i])).ApplyUpdates;
518 TZAbstractDataset(TDataSet(FDetailDataSets.Items[i])).CachedUpdates := Self.FDetailCachedUpdates[I];
520 FDetailDataSets.Clear;
521 SetLength(FDetailCachedUpdates, 0);
523 {BUG-FIX: bangfauzan addition}
524 if (SortedFields <> '') and not (doDontSortOnPost in Options) then
530 if BookmarkValid({$IFDEF WITH_TBOOKMARK}BM{$ELSE}@BM{$ENDIF}) Then
532 InternalGotoBookmark({$IFDEF WITH_TBOOKMARK}BM{$ELSE}@BM{$ENDIF});
533 Resync([rmExact, rmCenter]);
541 {end of bangfauzan addition}
543 Connection.HideSqlHourGlass;
549 Performs an internal record removing.
551 procedure TZAbstractDataset.InternalDelete;
554 RowBuffer: PZRowBuffer;
556 if (CachedResultSet <> nil) and GetActiveBuffer(RowBuffer) then
558 Connection.ShowSqlHourGlass;
560 RowNo := Integer(CurrentRows[CurrentRow - 1]);
561 CachedResultSet.MoveAbsolute(RowNo);
563 CachedResultSet.DeleteRow;
564 except on E: EZSQLThrowable do
565 raise EZDatabaseError.CreateFromException(E);
569 if not FilterRow(RowNo) then
571 CurrentRows.Delete(CurrentRow - 1);
572 if not FetchRows(CurrentRow) then
573 CurrentRow := Min(CurrentRows.Count, CurrentRow);
576 Connection.HideSQLHourGlass;
582 Performs an internal cancel updates.
584 procedure TZAbstractDataset.InternalCancel;
587 RowBuffer: PZRowBuffer;
589 if (CachedResultSet <> nil) and GetActiveBuffer(RowBuffer)
590 and (CurrentRow > 0) and (State = dsEdit) then
592 RowNo := Integer(CurrentRows[CurrentRow - 1]);
593 CachedResultSet.MoveAbsolute(RowNo);
594 RowAccessor.RowBuffer := RowBuffer;
595 FetchFromResultSet(CachedResultSet, FieldsLookupTable, Fields,
604 Processes component notifications.
605 @param AComponent a changed component object.
606 @param Operation a component operation code.
608 procedure TZAbstractDataset.Notification(AComponent: TComponent;
609 Operation: TOperation);
611 inherited Notification(AComponent, Operation);
613 if (Operation = opRemove) then
615 if (AComponent = FUpdateObject) then
618 FUpdateObject := nil;
620 if (AComponent = FSequence) then
628 Applies all cached updates stored in the resultset.
630 procedure TZAbstractDataset.ApplyUpdates;
635 Connection.ShowSQLHourGlass;
637 if State in [dsEdit, dsInsert] then
640 DoBeforeApplyUpdates; {bangfauzan addition}
642 if CachedResultSet <> nil then
643 if Connection.AutoCommit and
644 not ( Connection.TransactIsolationLevel in [tiReadCommitted, tiSerializable] ) then
645 CachedResultSet.PostUpdates
647 CachedResultSet.PostUpdatesCached;
649 if not (State in [dsInactive]) then
652 DOAfterApplyUpdates; {bangfauzan addition}
655 Connection.HideSqlHourGlass;
660 Dispose all cached updates stored in the resultset.
662 procedure TZAbstractDataset.DisposeCachedUpdates;
665 if Assigned(CachedResultSet) then
666 CachedResultSet.DisposeCachedUpdates;
670 Clears cached updates buffer.
672 procedure TZAbstractDataset.CommitUpdates;
676 if CachedResultSet <> nil then
677 CachedResultSet.CancelUpdates;
681 Cancels all cached updates and clears the buffer.
683 procedure TZAbstractDataset.CancelUpdates;
685 if State in [dsEdit, dsInsert] then
688 if CachedResultSet <> nil then
689 CachedResultSet.CancelUpdates;
691 if not (State in [dsInactive]) then
696 Reverts the previous status for the current row.
698 procedure TZAbstractDataset.RefreshCurrentRow(const RefreshDetails:Boolean);
702 ostate:TDataSetState;
704 if State=dsBrowse then
706 if CachedResultSet <> nil then
709 RowNo := Integer(CurrentRows[CurrentRow - 1]);
710 CachedResultSet.MoveAbsolute(RowNo);
711 CachedResultSet.RefreshRow;
712 if not (State in [dsInactive]) then
714 if RefreshDetails then
718 FetchFromResultSet(ResultSet, FieldsLookupTable, Fields, RowAccessor);
720 SetTempState(dsInternalCalc);
722 for I := 0 to Fields.Count - 1 do
723 DataEvent(deFieldChange,ULong(Fields[i]));
725 RestoreState(ostate);
733 raise EZDatabaseError.Create(SInternalError);
738 procedure TZAbstractDataset.RevertRecord;
740 if State in [dsInsert] then
745 if State in [dsEdit] then
748 if CachedResultSet <> nil then
749 CachedResultSet.RevertRecord;
751 if not (State in [dsInactive]) then
756 Checks is there cached updates pending in the buffer.
757 @return <code>True</code> if there some pending cached updates.
759 function TZAbstractDataset.GetUpdatesPending: Boolean;
761 if State = dsInactive then
763 else if (CachedResultSet <> nil) and CachedResultSet.IsPendingUpdates then
765 else if (State in [dsInsert, dsEdit]) then
771 {$IFDEF WITH_IPROVIDER}
774 Applies a single update to the underlying database table or tables.
775 @param UpdateKind an update type.
776 @param Delta a dataset where the current position shows the row to update.
777 @returns <code>True</code> if updates were successfully applied.
782 function TZAbstractDataset.PSUpdateRecord(UpdateKind: TUpdateKind;
783 Delta: TDataSet): Boolean;
790 function LocateRecord: Boolean;
797 FieldRefs: TObjectDynArray;
798 OnlyDataFields: Boolean;
800 if Properties.Values['KeyFields'] <> '' then
801 KeyFields := Properties.Values['KeyFields']
803 KeyFields := DefineKeyFields(Fields);
804 FieldRefs := DefineFields(Self, KeyFields, OnlyDataFields);
805 Temp := VarArrayCreate([0, Length(FieldRefs) - 1], varVariant);
807 for I := 0 to Length(FieldRefs) - 1 do
809 SrcField := Delta.FieldByName(TField(FieldRefs[I]).FieldName);
810 if SrcField <> nil then
812 Temp[I] := SrcField.OldValue;
818 if Length(FieldRefs) = 1 then
823 if KeyFields <> '' then
824 Result := Locate(KeyFields, KeyValues, [])
829 procedure CopyRecord(SrcDataset: TDataset; DestDataset: TDataset);
837 for I := 0 to DestDataset.FieldCount - 1 do
839 DestField := DestDataset.Fields[I];
840 SrcField := SrcDataset.FieldByName(DestField.FieldName);
841 if (SrcField = nil) or VarIsEmpty(SrcField.NewValue) then
844 if SrcField.IsNull then
850 case DestField.DataType of
853 if SrcField.DataType = ftLargeInt then
855 TLargeIntField(DestField).AsLargeInt :=
856 TLargeIntField(SrcField).AsLargeInt;
859 DestField.AsInteger := SrcField.AsInteger;
861 ftBlob, ftMemo {$IFDEF WITH_WIDEMEMO}, ftWideMemo{$ENDIF}:
863 if SrcField.DataType in [ftBlob, ftMemo {$IFDEF WITH_WIDEMEMO}, ftWideMemo{$ENDIF}] then
865 SrcStream := SrcDataset.CreateBlobStream(SrcField, bmRead);
867 DestStream := DestDataset.CreateBlobStream(DestField, bmWrite);
869 DestStream.CopyFrom(SrcStream, 0);
878 DestField.AsVariant := SrcField.AsVariant;
881 DestField.AsVariant := SrcField.AsVariant;
888 ActiveMode := Self.Active;
889 UpdateMode := Self.RequestLive;
891 if Self.RequestLive = False then
892 Self.RequestLive := True;
893 if Self.Active = False then
898 Self.DisableControls;
900 { Saves the current position. }
901 Bookmark := Self.GetBookmark;
911 CopyRecord(Delta, Self);
919 CopyRecord(Delta, Self);
936 { Restores the previous position. }
938 Self.GotoBookmark(Bookmark);
942 Self.FreeBookmark(Bookmark);
945 Self.RequestLive := UpdateMode;
946 Self.Active := ActiveMode;
954 procedure TZAbstractDataset.RegisterDetailDataSet(Value: TZAbstractDataset;
955 CachedUpdates: Boolean);
957 FDetailDataSets.Add(Value);
958 SetLength(Self.FDetailCachedUpdates, Length(FDetailCachedUpdates)+1);
959 FDetailCachedUpdates[High(FDetailCachedUpdates)] := CachedUpdates;
962 {============================bangfauzan addition===================}
964 procedure TZAbstractDataset.DOBeforeApplyUpdates;
966 if assigned(BeforeApplyUpdates) then
967 FBeforeApplyUpdates(Self);
970 procedure TZAbstractDataset.DOAfterApplyUpdates;
972 if assigned(AfterApplyUpdates) then
973 FAfterApplyUpdates(Self);
976 procedure TZAbstractDataset.EmptyDataSet;
981 Self.CurrentRows.Clear;
984 InitRecord(ActiveBuffer);
988 {========================end of bangfauzan addition================}