zeoslib  UNKNOWN
 All Files
ZAbstractDataset.pas
Go to the documentation of this file.
1 {*********************************************************}
2 { }
3 { Zeos Database Objects }
4 { Abstract Read/Write Dataset component }
5 { }
6 { Originally written by Sergey Seroukhov }
7 { }
8 {*********************************************************}
9 
10 {@********************************************************}
11 { Copyright (c) 1999-2012 Zeos Development Group }
12 { }
13 { License Agreement: }
14 { }
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. }
20 { }
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. }
39 { }
40 { }
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) }
45 { }
46 { http://www.sourceforge.net/projects/zeoslib. }
47 { }
48 { }
49 { Zeos Development Group. }
50 {********************************************************@}
51 
52 unit ZAbstractDataset;
53 
54 interface
55 
56 {$I ZComponent.inc}
57 
58 uses
59  Variants,
60  SysUtils, Classes, {$IFDEF MSEgui}mdb, mclasses{$ELSE}DB{$ENDIF},
61  ZSqlUpdate, ZDbcIntfs, ZVariant, ZDbcCache, ZDbcCachedResultSet,
62  ZAbstractRODataset, ZCompatibility, ZSequence;
63 
64 type
65  {$IFDEF oldFPC} // added in 2006, probably pre 2.2.4
66  TUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApplied);
67  {$ENDIF}
68 
69  {** Update Event type. }
70  TUpdateRecordEvent = procedure(DataSet: TDataSet; UpdateKind: TUpdateKind;
71  var UpdateAction: TUpdateAction) of object;
72 
73  {** Defines update modes for the resultsets. }
74  TZUpdateMode = (umUpdateChanged, umUpdateAll);
75 
76  {** Defines where form types for resultsets. }
77  TZWhereMode = (wmWhereKeyOnly, wmWhereAll);
78 
79  {**
80  Abstract dataset component which supports read/write access and
81  cached updates.
82  }
83  TZAbstractDataset = class(TZAbstractRODataset)
84  private
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;
96 
97  FBeforeApplyUpdates: TNotifyEvent; {bangfauzan addition}
98  FAfterApplyUpdates: TNotifyEvent; {bangfauzan addition}
99  FDetailDataSets: TList;
100  FDetailCachedUpdates: array of Boolean;
101  private
102  function GetUpdatesPending: Boolean;
103  procedure SetUpdateObject(Value: TZUpdateSQL);
104  procedure SetCachedUpdates(Value: Boolean);
105  procedure SetWhereMode(Value: TZWhereMode);
106  procedure SetUpdateMode(Value: TZUpdateMode);
107 
108  protected
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;
117 
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;
125 
126  procedure DOBeforeApplyUpdates; {bangfauzan addition}
127  procedure DOAfterApplyUpdates; {bangfauzan addition}
128 
129 
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);
135  override;
136 
137  {$IFDEF WITH_IPROVIDER}
138  function PSUpdateRecord(UpdateKind: TUpdateKind;
139  Delta: TDataSet): Boolean; override;
140  {$ENDIF}
141  procedure RegisterDetailDataSet(Value: TZAbstractDataset; CachedUpdates: Boolean);
142  procedure DisposeCachedUpdates;
143  public
144  constructor Create(AOwner: TComponent); override;
145  destructor Destroy; override;
146 
147  procedure ApplyUpdates;
148  procedure CommitUpdates;
149  procedure CancelUpdates;
150  procedure RevertRecord;
151  procedure RefreshCurrentRow(const RefreshDetails:Boolean); //FOS+ 07112006
152 
153  procedure EmptyDataSet; {bangfauzan addition}
154 
155  public
156  property UpdatesPending: Boolean read GetUpdatesPending;
157  property Sequence: TZSequence read FSequence write FSequence;
158  property SequenceField: string read FSequenceField write FSequenceField;
159 
160  published
161  property UpdateObject: TZUpdateSQL read FUpdateObject write SetUpdateObject;
162  property CachedUpdates: Boolean read FCachedUpdates write SetCachedUpdates
163  default False;
164 
165  property OnApplyUpdateError: TDataSetErrorEvent read FOnApplyUpdateError
166  write FOnApplyUpdateError;
167  property OnUpdateRecord: TUpdateRecordEvent read FOnUpdateRecord
168  write FOnUpdateRecord;
169 
170  property BeforeApplyUpdates: TNotifyEvent read FBeforeApplyUpdates
171  write FBeforeApplyUpdates; {bangfauzan addition}
172  property AfterApplyUpdates: TNotifyEvent read FAfterApplyUpdates
173  write FAfterApplyUpdates; {bangfauzan addition}
174 
175 
176  published
177  property BeforeInsert;
178  property AfterInsert;
179  property BeforeEdit;
180  property AfterEdit;
181  property BeforePost;
182  property AfterPost;
183  property BeforeCancel;
184  property AfterCancel;
185  property BeforeDelete;
186  property AfterDelete;
187  property OnDeleteError;
188  property OnEditError;
189  property OnPostError;
190  property OnNewRecord;
191  end;
192 
193 implementation
194 
195 uses Math, ZMessages, ZDatasetUtils;
196 
197 { TZAbstractDataset }
198 
199 {**
200  Constructs this object and assignes the mail properties.
201  @param AOwner a component owner.
202 }
203 constructor TZAbstractDataset.Create(AOwner: TComponent);
204 begin
205  inherited Create(AOwner);
206 
207  FWhereMode := wmWhereKeyOnly;
208  FUpdateMode := umUpdateChanged;
209  RequestLive := True;
210  FDetailDataSets := TList.Create;
211 end;
212 
213 {**
214  Destroys this object and cleanups the memory.
215 }
216 destructor TZAbstractDataset.Destroy;
217 begin
218  FreeAndNil(FDetailDataSets);
219  if Assigned(FUpdateObject) then
220  begin
221  FUpdateObject.DataSet := nil;
222  SetUpdateObject(nil);
223  end;
224  inherited Destroy;
225 end;
226 
227 {**
228  Sets a new UpdateSQL object.
229  @param Value a new UpdateSQL object.
230 }
231 procedure TZAbstractDataset.SetUpdateObject(Value: TZUpdateSQL);
232 begin
233  if FUpdateObject <> Value then
234  begin
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
243  begin
244  if FUpdateObject <> nil then
245  CachedResultSet.SetResolver(FUpdateObject)
246  else
247  CachedResultSet.SetResolver(CachedResolver);
248  end;
249  end;
250 end;
251 
252 {**
253  Sets a new CachedUpdates property value.
254  @param Value a new CachedUpdates value.
255 }
256 procedure TZAbstractDataset.SetCachedUpdates(Value: Boolean);
257 begin
258  if FCachedUpdates <> Value then
259  begin
260  FCachedUpdates := Value;
261  if Active and (CachedResultSet <> nil) then
262  CachedResultSet.SetCachedUpdates(Value);
263  end;
264 end;
265 
266 {**
267  Sets a new UpdateMode property value.
268  @param Value a new UpdateMode value.
269 }
270 procedure TZAbstractDataset.SetUpdateMode(Value: TZUpdateMode);
271 begin
272  if FUpdateMode <> Value then
273  begin
274  FUpdateMode := Value;
275  if Active then
276  Close;
277  end;
278 end;
279 
280 {**
281  Sets a new WhereMode property value.
282  @param Value a new WhereMode value.
283 }
284 procedure TZAbstractDataset.SetWhereMode(Value: TZWhereMode);
285 begin
286  if FWhereMode <> Value then
287  begin
288  FWhereMode := Value;
289  if Active then
290  Close;
291  end;
292 end;
293 
294 {**
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.
299 }
300 function TZAbstractDataset.CreateStatement(
301  const SQL: string; Properties: TStrings): IZPreparedStatement;
302 var
303  Temp: TStrings;
304 begin
305  Temp := TStringList.Create;
306  try
307  Temp.AddStrings(Properties);
308 
309  { Sets update mode property.}
310  case FUpdateMode of
311  umUpdateAll: Temp.Values['update'] := 'all';
312  umUpdateChanged: Temp.Values['update'] := 'changed';
313  end;
314  { Sets where mode property. }
315  case FWhereMode of
316  wmWhereAll: Temp.Values['where'] := 'all';
317  wmWhereKeyOnly: Temp.Values['where'] := 'keyonly';
318  end;
319 
320  Result := inherited CreateStatement(SQL, Temp);
321  finally
322  Temp.Free;
323  end;
324 end;
325 
326 {**
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.
331 }
332 function TZAbstractDataset.CreateResultSet(const SQL: string; MaxRows: Integer):
333  IZResultSet;
334 begin
335  Result := inherited CreateResultSet(SQL, MaxRows);
336 
337  if not Assigned(Result) then
338  Exit;
339 
340  if Result.QueryInterface(IZCachedResultSet, FCachedResultSet) = 0 then
341  begin
342  CachedResultSet := Result as IZCachedResultSet;
343  CachedResolver := CachedResultSet.GetResolver;
344  CachedResultSet.SetCachedUpdates(CachedUpdates);
345  if FUpdateObject <> nil then
346  CachedResultSet.SetResolver(FUpdateObject);
347  end;
348 end;
349 
350 {**
351  Performs internal query closing.
352 }
353 procedure TZAbstractDataset.InternalClose;
354 begin
355  inherited InternalClose;
356 
357  if not DoNotCloseResultset then
358  begin
359  if Assigned(CachedResultSet) then
360  CachedResultSet.Close;
361  CachedResultSet := nil;
362  CachedResolver := nil;
363  end;
364 end;
365 
366 {**
367  Performs an internal action before switch into edit mode.
368 }
369 procedure TZAbstractDataset.InternalEdit;
370 begin
371 end;
372 
373 {**
374  Performs an internal record updates.
375 }
376 {$IFDEF FPC}
377  {$HINTS OFF}
378 {$ENDIF}
379 procedure TZAbstractDataset.InternalUpdate;
380 var
381  RowNo: Integer;
382  RowBuffer: PZRowBuffer;
383 begin
384  if (CachedResultSet <> nil) and GetActiveBuffer(RowBuffer) then
385  begin
386  RowNo := Integer(CurrentRows[CurrentRow - 1]);
387  CachedResultSet.MoveAbsolute(RowNo);
388  RowAccessor.RowBuffer := RowBuffer;
389  PostToResultSet(CachedResultSet, FieldsLookupTable, Fields, RowAccessor);
390  try
391  CachedResultSet.UpdateRow;
392  except on E: EZSQLThrowable do
393  raise EZDatabaseError.CreateFromException(E);
394  end;
395 
396  { Filters the row }
397  if not FilterRow(RowNo) then
398  begin
399  CurrentRows.Delete(CurrentRow - 1);
400  CurrentRow := Min(CurrentRows.Count, CurrentRow);
401  end;
402  end;
403 end;
404 {$IFDEF FPC}
405  {$HINTS ON}
406 {$ENDIF}
407 
408 {**
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
412  of the result set.
413 }
414 {$IFDEF FPC}
415  {$HINTS OFF}
416 {$ENDIF}
417 procedure TZAbstractDataset.InternalAddRecord(Buffer: Pointer; Append: Boolean);
418 var
419  RowNo: Integer;
420  RowBuffer: PZRowBuffer;
421 begin
422  if not GetActiveBuffer(RowBuffer) or (RowBuffer <> Buffer) then
423  raise EZDatabaseError.Create(SInternalError);
424 
425  if Append then
426  FetchRows(0);
427 
428  if CachedResultSet <> nil then
429  begin
430  CachedResultSet.MoveToInsertRow;
431  RowAccessor.RowBuffer := RowBuffer;
432  PostToResultSet(CachedResultSet, FieldsLookupTable, Fields, RowAccessor);
433  try
434  CachedResultSet.InsertRow;
435  except on E: EZSQLThrowable do
436  raise EZDatabaseError.CreateFromException(E);
437  end;
438  RowNo := CachedResultSet.GetRow;
439  FetchCount := FetchCount + 1;
440 
441  { Filters the row }
442  if FilterRow(RowNo) then
443  begin
444  if Append then
445  begin
446  CurrentRows.Add(Pointer(RowNo));
447  CurrentRow := CurrentRows.Count;
448  end
449  else
450  begin
451  CurrentRow := Max(CurrentRow, 1);
452  CurrentRows.Insert(CurrentRow - 1, Pointer(RowNo));
453  end;
454  end;
455  end;
456 end;
457 {$IFDEF FPC}
458  {$HINTS ON}
459 {$ENDIF}
460 
461 
462 {**
463  Performs an internal post updates.
464 }
465 {$IFDEF FPC}
466  {$HINTS OFF}
467 {$ENDIF}
468 procedure TZAbstractDataset.InternalPost;
469 var
470  RowBuffer: PZRowBuffer;
471  {$IFDEF WITH_TBOOKMARK}
472  BM: TBookMark;
473  {$ELSE}
474  BM:TBookMarkStr;
475  {$ENDIF}
476  I: Integer;
477 begin
478  if (FSequenceField <> '') and Assigned(FSequence) then
479  begin
480  if FieldByName(FSequenceField).IsNull then
481  FieldByName(FSequenceField).Value := FSequence.GetNextValue;
482  end;
483 
484  //inherited; //AVZ - Firebird defaults come through when this is commented out
485 
486 
487  if not GetActiveBuffer(RowBuffer) then
488  raise EZDatabaseError.Create(SInternalError);
489 
490  Connection.ShowSqlHourGlass;
491  try
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);
504  end;
505 
506  if State = dsInsert then
507  InternalAddRecord(RowBuffer, False)
508  else
509  InternalUpdate;
510 
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
515  begin
516  if not (Self.FDetailCachedUpdates[I]) then
517  TZAbstractDataset(TDataSet(FDetailDataSets.Items[i])).ApplyUpdates;
518  TZAbstractDataset(TDataSet(FDetailDataSets.Items[i])).CachedUpdates := Self.FDetailCachedUpdates[I];
519  end;
520  FDetailDataSets.Clear;
521  SetLength(FDetailCachedUpdates, 0);
522 
523  {BUG-FIX: bangfauzan addition}
524  if (SortedFields <> '') and not (doDontSortOnPost in Options) then
525  begin
526  FreeFieldBuffers;
527  SetState(dsBrowse);
528  Resync([]);
529  BM := Bookmark;
530  if BookmarkValid({$IFDEF WITH_TBOOKMARK}BM{$ELSE}@BM{$ENDIF}) Then
531  begin
532  InternalGotoBookmark({$IFDEF WITH_TBOOKMARK}BM{$ELSE}@BM{$ENDIF});
533  Resync([rmExact, rmCenter]);
534  end;
535  DisableControls;
536  InternalSort;
537  BookMark:=BM;
538  UpdateCursorPos;
539  EnableControls;
540  end;
541  {end of bangfauzan addition}
542  finally
543  Connection.HideSqlHourGlass;
544  //DetailLinks.Free;
545  end;
546 end;
547 
548 {**
549  Performs an internal record removing.
550 }
551 procedure TZAbstractDataset.InternalDelete;
552 var
553  RowNo: Integer;
554  RowBuffer: PZRowBuffer;
555 begin
556  if (CachedResultSet <> nil) and GetActiveBuffer(RowBuffer) then
557  begin
558  Connection.ShowSqlHourGlass;
559  try
560  RowNo := Integer(CurrentRows[CurrentRow - 1]);
561  CachedResultSet.MoveAbsolute(RowNo);
562  try
563  CachedResultSet.DeleteRow;
564  except on E: EZSQLThrowable do
565  raise EZDatabaseError.CreateFromException(E);
566  end;
567 
568  { Filters the row }
569  if not FilterRow(RowNo) then
570  begin
571  CurrentRows.Delete(CurrentRow - 1);
572  if not FetchRows(CurrentRow) then
573  CurrentRow := Min(CurrentRows.Count, CurrentRow);
574  end;
575  finally
576  Connection.HideSQLHourGlass;
577  end;
578  end;
579 end;
580 
581 {**
582  Performs an internal cancel updates.
583 }
584 procedure TZAbstractDataset.InternalCancel;
585 var
586  RowNo: Integer;
587  RowBuffer: PZRowBuffer;
588 begin
589  if (CachedResultSet <> nil) and GetActiveBuffer(RowBuffer)
590  and (CurrentRow > 0) and (State = dsEdit) then
591  begin
592  RowNo := Integer(CurrentRows[CurrentRow - 1]);
593  CachedResultSet.MoveAbsolute(RowNo);
594  RowAccessor.RowBuffer := RowBuffer;
595  FetchFromResultSet(CachedResultSet, FieldsLookupTable, Fields,
596  RowAccessor);
597  end;
598 end;
599 {$IFDEF FPC}
600  {$HINTS ON}
601 {$ENDIF}
602 
603 {**
604  Processes component notifications.
605  @param AComponent a changed component object.
606  @param Operation a component operation code.
607 }
608 procedure TZAbstractDataset.Notification(AComponent: TComponent;
609  Operation: TOperation);
610 begin
611  inherited Notification(AComponent, Operation);
612 
613  if (Operation = opRemove) then
614  begin
615  if (AComponent = FUpdateObject) then
616  begin
617  Close;
618  FUpdateObject := nil;
619  end;
620  if (AComponent = FSequence) then
621  begin
622  FSequence := nil;
623  end;
624  end;
625 end;
626 
627 {**
628  Applies all cached updates stored in the resultset.
629 }
630 procedure TZAbstractDataset.ApplyUpdates;
631 begin
632  if not Active then
633  Exit;
634 
635  Connection.ShowSQLHourGlass;
636  try
637  if State in [dsEdit, dsInsert] then
638  Post;
639 
640  DoBeforeApplyUpdates; {bangfauzan addition}
641 
642  if CachedResultSet <> nil then
643  if Connection.AutoCommit and
644  not ( Connection.TransactIsolationLevel in [tiReadCommitted, tiSerializable] ) then
645  CachedResultSet.PostUpdates
646  else
647  CachedResultSet.PostUpdatesCached;
648  UpdateCursorPos;
649  if not (State in [dsInactive]) then
650  Resync([]);
651 
652  DOAfterApplyUpdates; {bangfauzan addition}
653 
654  finally
655  Connection.HideSqlHourGlass;
656  end;
657 end;
658 
659 {**
660  Dispose all cached updates stored in the resultset.
661 }
662 procedure TZAbstractDataset.DisposeCachedUpdates;
663 begin
664  if Active then
665  if Assigned(CachedResultSet) then
666  CachedResultSet.DisposeCachedUpdates;
667 end;
668 
669 {**
670  Clears cached updates buffer.
671 }
672 procedure TZAbstractDataset.CommitUpdates;
673 begin
674  CheckBrowseMode;
675 
676  if CachedResultSet <> nil then
677  CachedResultSet.CancelUpdates;
678 end;
679 
680 {**
681  Cancels all cached updates and clears the buffer.
682 }
683 procedure TZAbstractDataset.CancelUpdates;
684 begin
685  if State in [dsEdit, dsInsert] then
686  Cancel;
687 
688  if CachedResultSet <> nil then
689  CachedResultSet.CancelUpdates;
690 
691  if not (State in [dsInactive]) then
692  RereadRows;
693 end;
694 
695 {**
696  Reverts the previous status for the current row.
697 }
698 procedure TZAbstractDataset.RefreshCurrentRow(const RefreshDetails:Boolean);
699 var
700  RowNo: integer;
701  i: Integer;
702  ostate:TDataSetState;
703 begin
704  if State=dsBrowse then
705  begin
706  if CachedResultSet <> nil then
707  begin
708  UpdateCursorPos;
709  RowNo := Integer(CurrentRows[CurrentRow - 1]);
710  CachedResultSet.MoveAbsolute(RowNo);
711  CachedResultSet.RefreshRow;
712  if not (State in [dsInactive]) then
713  begin
714  if RefreshDetails then
715  Resync([])
716  else
717  begin
718  FetchFromResultSet(ResultSet, FieldsLookupTable, Fields, RowAccessor);
719  ostate:=State;
720  SetTempState(dsInternalCalc);
721  try
722  for I := 0 to Fields.Count - 1 do
723  DataEvent(deFieldChange,ULong(Fields[i]));
724  finally
725  RestoreState(ostate);
726  end;
727  end;
728  end;
729  end;
730  end
731  else
732  begin
733  raise EZDatabaseError.Create(SInternalError);
734  end;
735 end;
736 
737 
738 procedure TZAbstractDataset.RevertRecord;
739 begin
740  if State in [dsInsert] then
741  begin
742  Cancel;
743  Exit;
744  end;
745  if State in [dsEdit] then
746  Cancel;
747 
748  if CachedResultSet <> nil then
749  CachedResultSet.RevertRecord;
750 
751  if not (State in [dsInactive]) then
752  Resync([]);
753 end;
754 
755 {**
756  Checks is there cached updates pending in the buffer.
757  @return <code>True</code> if there some pending cached updates.
758 }
759 function TZAbstractDataset.GetUpdatesPending: Boolean;
760 begin
761  if State = dsInactive then
762  Result := False
763  else if (CachedResultSet <> nil) and CachedResultSet.IsPendingUpdates then
764  Result := True
765  else if (State in [dsInsert, dsEdit]) then
766  Result := Modified
767  else
768  Result := False;
769 end;
770 
771 {$IFDEF WITH_IPROVIDER}
772 
773 {**
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.
778 }
779 {$IFDEF FPC}
780  {$HINTS OFF}
781 {$ENDIF}
782 function TZAbstractDataset.PSUpdateRecord(UpdateKind: TUpdateKind;
783  Delta: TDataSet): Boolean;
784 
785 var
786  Bookmark: TBookmark;
787  ActiveMode: Boolean;
788  UpdateMode: Boolean;
789 
790  function LocateRecord: Boolean;
791  var
792  I: Integer;
793  KeyFields: string;
794  Temp: Variant;
795  SrcField: TField;
796  KeyValues: Variant;
797  FieldRefs: TObjectDynArray;
798  OnlyDataFields: Boolean;
799  begin
800  if Properties.Values['KeyFields'] <> '' then
801  KeyFields := Properties.Values['KeyFields']
802  else
803  KeyFields := DefineKeyFields(Fields);
804  FieldRefs := DefineFields(Self, KeyFields, OnlyDataFields);
805  Temp := VarArrayCreate([0, Length(FieldRefs) - 1], varVariant);
806 
807  for I := 0 to Length(FieldRefs) - 1 do
808  begin
809  SrcField := Delta.FieldByName(TField(FieldRefs[I]).FieldName);
810  if SrcField <> nil then
811  begin
812  Temp[I] := SrcField.OldValue;
813  end
814  else
815  Temp[I] := Null;
816  end;
817 
818  if Length(FieldRefs) = 1 then
819  KeyValues := Temp[0]
820  else
821  KeyValues := Temp;
822 
823  if KeyFields <> '' then
824  Result := Locate(KeyFields, KeyValues, [])
825  else
826  Result := False;
827  end;
828 
829  procedure CopyRecord(SrcDataset: TDataset; DestDataset: TDataset);
830  var
831  I: Integer;
832  SrcField: TField;
833  DestField: TField;
834  SrcStream: TStream;
835  DestStream: TStream;
836  begin
837  for I := 0 to DestDataset.FieldCount - 1 do
838  begin
839  DestField := DestDataset.Fields[I];
840  SrcField := SrcDataset.FieldByName(DestField.FieldName);
841  if (SrcField = nil) or VarIsEmpty(SrcField.NewValue) then
842  Continue;
843 
844  if SrcField.IsNull then
845  begin
846  DestField.Clear;
847  Continue;
848  end;
849 
850  case DestField.DataType of
851  ftLargeInt:
852  begin
853  if SrcField.DataType = ftLargeInt then
854  begin
855  TLargeIntField(DestField).AsLargeInt :=
856  TLargeIntField(SrcField).AsLargeInt;
857  end
858  else
859  DestField.AsInteger := SrcField.AsInteger;
860  end;
861  ftBlob, ftMemo {$IFDEF WITH_WIDEMEMO}, ftWideMemo{$ENDIF}:
862  begin
863  if SrcField.DataType in [ftBlob, ftMemo {$IFDEF WITH_WIDEMEMO}, ftWideMemo{$ENDIF}] then
864  begin
865  SrcStream := SrcDataset.CreateBlobStream(SrcField, bmRead);
866  try
867  DestStream := DestDataset.CreateBlobStream(DestField, bmWrite);
868  try
869  DestStream.CopyFrom(SrcStream, 0);
870  finally
871  DestStream.Free;
872  end;
873  finally
874  SrcStream.Free;
875  end;
876  end
877  else
878  DestField.AsVariant := SrcField.AsVariant;
879  end;
880  else
881  DestField.AsVariant := SrcField.AsVariant;
882  end;
883  end;
884  end;
885 
886 begin
887  Result := False;
888  ActiveMode := Self.Active;
889  UpdateMode := Self.RequestLive;
890 
891  if Self.RequestLive = False then
892  Self.RequestLive := True;
893  if Self.Active = False then
894  Self.Open;
895 
896  CheckBrowseMode;
897  try
898  Self.DisableControls;
899 
900  { Saves the current position. }
901  Bookmark := Self.GetBookmark;
902 
903  { Applies updates. }
904  try
905  case UpdateKind of
906  ukModify:
907  begin
908  if LocateRecord then
909  begin
910  Self.Edit;
911  CopyRecord(Delta, Self);
912  Self.Post;
913  Result := True;
914  end;
915  end;
916  ukInsert:
917  begin
918  Self.Append;
919  CopyRecord(Delta, Self);
920  Self.Post;
921  Result := True;
922  end;
923  ukDelete:
924  begin
925  if LocateRecord then
926  begin
927  Self.Delete;
928  Result := True;
929  end;
930  end;
931  end;
932  except
933  Result := False;
934  end;
935 
936  { Restores the previous position. }
937  try
938  Self.GotoBookmark(Bookmark);
939  except
940  Self.First;
941  end;
942  Self.FreeBookmark(Bookmark);
943  finally
944  EnableControls;
945  Self.RequestLive := UpdateMode;
946  Self.Active := ActiveMode;
947  end;
948 end;
949 {$IFDEF FPC}
950  {$HINTS ON}
951 {$ENDIF}
952 
953 {$ENDIF}
954 procedure TZAbstractDataset.RegisterDetailDataSet(Value: TZAbstractDataset;
955  CachedUpdates: Boolean);
956 begin
957  FDetailDataSets.Add(Value);
958  SetLength(Self.FDetailCachedUpdates, Length(FDetailCachedUpdates)+1);
959  FDetailCachedUpdates[High(FDetailCachedUpdates)] := CachedUpdates;
960 end;
961 
962 {============================bangfauzan addition===================}
963 
964 procedure TZAbstractDataset.DOBeforeApplyUpdates;
965 begin
966  if assigned(BeforeApplyUpdates) then
967  FBeforeApplyUpdates(Self);
968 end;
969 
970 procedure TZAbstractDataset.DOAfterApplyUpdates;
971 begin
972  if assigned(AfterApplyUpdates) then
973  FAfterApplyUpdates(Self);
974 end;
975 
976 procedure TZAbstractDataset.EmptyDataSet;
977 begin
978  if Active then
979  begin
980  Self.CancelUpdates;
981  Self.CurrentRows.Clear;
982  Self.CurrentRow:=0;
983  Resync([]);
984  InitRecord(ActiveBuffer);
985  end;
986 end;
987 
988 {========================end of bangfauzan addition================}
989 
990 end.
991