zeoslib  UNKNOWN
 All Files
ZSqlUpdate.pas
Go to the documentation of this file.
1 {*********************************************************}
2 { }
3 { Zeos Database Objects }
4 { Unidatabase UpdateSQL 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 ZSqlUpdate;
53 
54 interface
55 
56 {$I ZComponent.inc}
57 
58 uses
59  SysUtils, Classes, {$IFDEF MSEgui}mclasses, mdb{$ELSE}DB{$ENDIF},
60  ZDbcIntfs, ZDbcCachedResultSet, ZDbcCache, ZSqlStrings;
61 
62 type
63  {ADDED BY fduenas}
64  TZBeforeSQLStatementEvent = procedure(const Sender: TObject;
65  StatementIndex: Integer; out Execute: Boolean ) of object;
66 
67  TZAfterSQLStatementEvent = procedure(const Sender: TObject;
68  StatementIndex: Integer) of object;
69 
70  TZAfterInsertSQLStatementEvent = procedure(const Sender: TObject;
71  StatementIndex: Integer; out UpdateAutoIncFields: Boolean ) of object;
72 
73  {**
74  Implements an object which manages SQL DML statements to update TDatasets.
75  }
76  TZUpdateSQL = class(TComponent, IZCachedResolver)
77  private
78  FDataSet: TDataSet;
79 
80  FDeleteSQL: TZSQLStrings;
81  FInsertSQL: TZSQLStrings;
82  FModifySQL: TZSQLStrings;
83  //FOSPATCH
84  FRefreshSQL: TZSQLStrings;
85  //FOSPATCH
86 
87  FParamCheck: Boolean;
88  FParams: TParams;
89  FMultiStatements: Boolean;
90  FBeforeDeleteSQL: TNotifyEvent;
91  FBeforeInsertSQL: TNotifyEvent;
92  FBeforeModifySQL: TNotifyEvent;
93  FAfterDeleteSQL: TNotifyEvent;
94  FAfterInsertSQL: TNotifyEvent;
95  FAfterModifySQL: TNotifyEvent;
96  FUseSequenceFieldForRefreshSQL: Boolean;
97  {New Statement Events added by Fduenas}
98  FBeforeDeleteSQLStatement: TZBeforeSQLStatementEvent;
99  FAfterDeleteSQLStatement: TZAfterSQLStatementEvent;
100  FBeforeInsertSQLStatement: TZBeforeSQLStatementEvent;
101  FAfterInsertSQLStatement: TZAfterInsertSQLStatementEvent;
102  FBeforeModifySQLStatement: TZBeforeSQLStatementEvent;
103  FAfterModifySQLStatement: TZAfterSQLStatementEvent;
104 
105  procedure SetUseSequenceFieldForRefreshSQL(const Value: Boolean);
106  procedure SetDataset(Value: TDataset);
107  function GetSQL(UpdateKind: TUpdateKind): TStrings;
108  procedure SetSQL(UpdateKind: TUpdateKind; Value: TStrings);
109  function GetParamsCount: Word;
110  procedure SetParamsList(Value: TParams);
111  procedure SetParamCheck(Value: Boolean);
112  procedure SetMultiStatements(Value: Boolean);
113 
114  function GetDeleteSQL: TStrings;
115  procedure SetDeleteSQL(Value: TStrings);
116  function GetInsertSQL: TStrings;
117  procedure SetInsertSQL(Value: TStrings);
118  function GetModifySQL: TStrings;
119  procedure SetModifySQL(Value: TStrings);
120 
121  //FOSPATCH
122  function GetRefreshSQL: TStrings;
123  procedure SetRefreshSQL(Value: TStrings);
124  //FOSPATCH
125 
126  procedure ReadParamData(Reader: TReader);
127  procedure WriteParamData(Writer: TWriter);
128 
129 
130  protected
131  procedure Apply_RefreshResultSet(const Sender:IZCachedResultSet;const RefreshResultSet: IZResultSet;const RefreshRowAccessor:TZRowAccessor);
132 
133  procedure DefineProperties(Filer: TFiler); override;
134  procedure CalculateDefaults(Sender: IZCachedResultSet;
135  RowAccessor: TZRowAccessor);
136  procedure PostUpdates(Sender: IZCachedResultSet; UpdateType: TZRowUpdateType;
137  OldRowAccessor, NewRowAccessor: TZRowAccessor);
138  {BEGIN of PATCH [1185969]: Do tasks after posting updates. ie: Updating AutoInc fields in MySQL }
139  procedure UpdateAutoIncrementFields(Sender: IZCachedResultSet; UpdateType: TZRowUpdateType;
140  OldRowAccessor, NewRowAccessor: TZRowAccessor; Resolver: IZCachedResolver);
141  {END of PATCH [1185969]: Do tasks after posting updates. ie: Updating AutoInc fields in MySQL }
142 
143  procedure RefreshCurrentRow(Sender: IZCachedResultSet;RowAccessor: TZRowAccessor);//FOS+ 07112006
144 
145  procedure Rebuild(SQLStrings: TZSQLStrings);
146  procedure RebuildAll;
147  procedure FillStatement(ResultSet: IZCachedResultSet;
148  Statement: IZPreparedStatement; Config: TZSQLStatement;
149  OldRowAccessor, NewRowAccessor: TZRowAccessor);
150  procedure UpdateParams(Sender: TObject);
151 
152  procedure DoBeforeDeleteSQL;
153  procedure DoBeforeInsertSQL;
154  procedure DoBeforeModifySQL;
155  procedure DoAfterDeleteSQL;
156  procedure DoAfterInsertSQL;
157  procedure DoAfterModifySQL;
158 
159  procedure DoBeforeDeleteSQLStatement(const Sender: TObject;
160  StatementIndex: Integer; out Execute: Boolean);
161  procedure DoBeforeInsertSQLStatement(const Sender: TObject;
162  StatementIndex: Integer; out Execute: Boolean);
163  procedure DoBeforeModifySQLStatement(const Sender: TObject;
164  StatementIndex: Integer; out Execute: Boolean);
165  procedure DoAfterDeleteSQLStatement(const Sender: TObject;
166  StatementIndex: Integer);
167  procedure DoAfterInsertSQLStatement(const Sender: TObject;
168  StatementIndex: Integer; out UpdateAutoIncFields: Boolean) ;
169  procedure DoAfterModifySQLStatement(const Sender: TObject;
170  StatementIndex: Integer);
171  public
172  constructor Create(AOwner: TComponent); override;
173  destructor Destroy; override;
174 
175  property SQL[UpdateKind: TUpdateKind]: TStrings read GetSQL write SetSQL;
176  property ParamCount: Word read GetParamsCount;
177  property DataSet: TDataSet read FDataSet write SetDataSet;
178 
179  published
180  property DeleteSQL: TStrings read GetDeleteSQL write SetDeleteSQL;
181  property InsertSQL: TStrings read GetInsertSQL write SetInsertSQL;
182  property ModifySQL: TStrings read GetModifySQL write SetModifySQL;
183  //FOSPATCH
184  property RefreshSQL: TStrings read GetRefreshSQL write SetRefreshSQL;
185  //FOSPATCH
186  property UseSequenceFieldForRefreshSQL:Boolean read FUseSequenceFieldForRefreshSQL write SetUseSequenceFieldForRefreshSQL;
187 
188 
189  property Params: TParams read FParams write SetParamsList stored False;
190  property ParamCheck: Boolean read FParamCheck write SetParamCheck default True;
191  property MultiStatements: Boolean read FMultiStatements write SetMultiStatements default True;
192 
193  property BeforeDeleteSQL: TNotifyEvent
194  read FBeforeDeleteSQL write FBeforeDeleteSQL;
195  property BeforeInsertSQL: TNotifyEvent
196  read FBeforeInsertSQL write FBeforeInsertSQL;
197  property BeforeModifySQL: TNotifyEvent
198  read FBeforeModifySQL write FBeforeModifySQL;
199  property AfterDeleteSQL: TNotifyEvent
200  read FAfterDeleteSQL write FAfterDeleteSQL;
201  property AfterInsertSQL: TNotifyEvent
202  read FAfterInsertSQL write FAfterInsertSQL;
203  property AfterModifySQL: TNotifyEvent
204  read FAfterModifySQL write FAfterModifySQL;
205 
206  {New Events Fired by executed Statement}
207  property BeforeDeleteSQLStatement: TZBeforeSQLStatementEvent
208  read FBeforeDeleteSQLStatement write FBeforeDeleteSQLStatement;
209  property BeforeInsertSQLStatement: TZBeforeSQLStatementEvent
210  read FBeforeInsertSQLStatement write FBeforeInsertSQLStatement;
211  property BeforeModifySQLStatement: TZBeforeSQLStatementEvent
212  read FBeforeModifySQLStatement write FBeforeModifySQLStatement;
213  property AfterDeleteSQLStatement: TZAfterSQLStatementEvent
214  read FAfterDeleteSQLStatement write FAfterDeleteSQLStatement;
215  property AfterInsertSQLStatement: TZAfterInsertSQLStatementEvent
216  read FAfterInsertSQLStatement write FAfterInsertSQLStatement;
217  property AfterModifySQLStatement: TZAfterSQLStatementEvent
218  read FAfterModifySQLStatement write FAfterModifySQLStatement;
219  end;
220 
221 implementation
222 
223 uses ZGenericSqlToken, ZDatasetUtils, ZAbstractRODataset,ZAbstractDataset,
224  ZSysUtils, ZDbcUtils,ZMessages;
225 
226 { TZUpdateSQL }
227 
228 {**
229  Constructs this object and assignes main properties.
230  @param AOwner a component owner.
231 }
232 constructor TZUpdateSQL.Create(AOwner: TComponent);
233 begin
234  inherited Create(AOwner);
235 
236  FDeleteSQL := TZSQLStrings.Create;
237  FDeleteSQL.OnChange := UpdateParams;
238  FInsertSQL := TZSQLStrings.Create;
239  FInsertSQL.OnChange := UpdateParams;
240  FModifySQL := TZSQLStrings.Create;
241  FModifySQL.OnChange := UpdateParams;
242 
243 //FOSPATCH
244  FRefreshSQL := TZSQLStrings.Create;
245  FRefreshSQL.OnChange:= UpdateParams;
246 //FOSPATCH
247 
248  FParams := TParams.Create(Self);
249  FParamCheck := True;
250  FMultiStatements := True;
251 end;
252 
253 {**
254  Destroys this object and cleanups the memory.
255 }
256 destructor TZUpdateSQL.Destroy;
257 begin
258  FParams.Free;
259  FDeleteSQL.Free;
260  FInsertSQL.Free;
261  FModifySQL.Free;
262  FRefreshSQL.Free;
263  {keep track we notify a possible opened DataSet.CachedResultSet about destruction
264  else IntfAssign of FPC fails to clear the cached resolver of the CachedResultSet}
265  if Assigned(FDataSet) and (FDataSet is TZAbstractDataset) then
266  TZAbstractDataset(DataSet).UpdateObject := nil;
267 
268  inherited Destroy;
269 end;
270 
271 {**
272  Store the related dataset object for update sql editor
273 }
274 procedure TZUpdateSQL.SetDataset(Value: TDataset);
275 begin
276  FDataSet := Value;
277  FDeleteSQL.Dataset := Value;
278  FInsertSQL.Dataset := Value;
279  FModifySQL.Dataset := Value;
280 end;
281 
282 {**
283  Gets a DML statements for specified action.
284  @param UpdateKind a type of the DML statements.
285  @return a stored DML statement.
286 }
287 function TZUpdateSQL.GetSQL(UpdateKind: TUpdateKind): TStrings;
288 begin
289  case UpdateKind of
290  ukModify: Result := FModifySQL;
291  ukInsert: Result := FInsertSQL;
292  else
293  Result := FDeleteSQL;
294  end;
295 end;
296 
297 {**
298  Sets a DML statements for specified action.
299  @param UpdateKind a type of the DML statements.
300  @param Value a DML statements to be set.
301 }
302 procedure TZUpdateSQL.SetSQL(UpdateKind: TUpdateKind; Value: TStrings);
303 begin
304  case UpdateKind of
305  ukModify: FModifySQL.Assign(Value);
306  ukInsert: FInsertSQL.Assign(Value);
307  ukDelete: FDeleteSQL.Assign(Value);
308  end;
309 end;
310 
311 {**
312  Get parameters count.
313  @return a parameters count.
314 }
315 function TZUpdateSQL.GetParamsCount: Word;
316 begin
317  Result := FParams.Count;
318 end;
319 
320 function TZUpdateSQL.GetRefreshSQL: TStrings;
321 begin
322  Result := FRefreshSQL;
323 end;
324 
325 {**
326  Sets parameters checking flag.
327  @param Value a new parameters checking flag.
328 }
329 procedure TZUpdateSQL.SetParamCheck(Value: Boolean);
330 begin
331  if FParamCheck <> Value then
332  begin
333  FParamCheck := Value;
334  FModifySQL.ParamCheck := Value;
335  FInsertSQL.ParamCheck := Value;
336  FDeleteSQL.ParamCheck := Value;
337  RebuildAll;
338  end;
339 end;
340 
341 {**
342  Sets multiple statements flag.
343  @param Value a new multiple statements flag.
344 }
345 procedure TZUpdateSQL.SetMultiStatements(Value: Boolean);
346 begin
347  if FMultiStatements <> Value then
348  begin
349  FMultiStatements := Value;
350  FModifySQL.MultiStatements := Value;
351  FInsertSQL.MultiStatements := Value;
352  FDeleteSQL.MultiStatements := Value;
353  RebuildAll;
354  end;
355 end;
356 
357 {**
358  Set a new list of SQL parameters.
359  @param Value a new list of SQL parameters.
360 }
361 procedure TZUpdateSQL.SetParamsList(Value: TParams);
362 begin
363  FParams.AssignValues(Value);
364 end;
365 
366 procedure TZUpdateSQL.SetRefreshSQL(Value: TStrings);
367 begin
368  FRefreshSQL.Assign(Value);
369 end;
370 
371 procedure TZUpdateSQL.SetUseSequenceFieldForRefreshSQL(const Value: Boolean);
372 begin
373  FUseSequenceFieldForRefreshSQL := Value;
374 end;
375 
376 {**
377  Defines a persistent dataset properties.
378  @param Filer a persistent manager object.
379 }
380 procedure TZUpdateSQL.DefineProperties(Filer: TFiler);
381 
382  function WriteData: Boolean;
383  begin
384  if Filer.Ancestor <> nil then
385  Result := not FParams.IsEqual(TZUpdateSQL(Filer.Ancestor).FParams)
386  else
387  Result := FParams.Count > 0;
388  end;
389 
390 begin
391  inherited DefineProperties(Filer);
392  Filer.DefineProperty('ParamData', ReadParamData, WriteParamData, WriteData);
393 end;
394 
395 {**
396  Reads parameter data from persistent storage.
397  @param Reader an input data stream.
398 }
399 procedure TZUpdateSQL.ReadParamData(Reader: TReader);
400 begin
401  Reader.ReadValue;
402  Reader.ReadCollection(FParams);
403 end;
404 
405 {**
406  Writes parameter data from persistent storage.
407  @param Writer an output data stream.
408 }
409 procedure TZUpdateSQL.WriteParamData(Writer: TWriter);
410 begin
411  Writer.WriteCollection(Params);
412 end;
413 
414 {**
415  Gets strings with Delete statements.
416  @return strings with Delete statements.
417 }
418 function TZUpdateSQL.GetDeleteSQL: TStrings;
419 begin
420  Result := FDeleteSQL;
421 end;
422 
423 {**
424  Sets a new Delete SQL statement.
425  @param Value a new Delete SQL statement.
426 }
427 procedure TZUpdateSQL.SetDeleteSQL(Value: TStrings);
428 begin
429  FDeleteSQL.Assign(Value);
430 end;
431 
432 {**
433  Gets strings with Insert statements.
434  @return strings with Insert statements.
435 }
436 function TZUpdateSQL.GetInsertSQL: TStrings;
437 begin
438  Result := FInsertSQL;
439 end;
440 
441 {**
442  Sets a new Insert SQL statement.
443  @param Value a new Insert SQL statement.
444 }
445 procedure TZUpdateSQL.SetInsertSQL(Value: TStrings);
446 begin
447  FInsertSQL.Assign(Value);
448 end;
449 
450 {**
451  Gets strings with Modify statements.
452  @return strings with Modify statements.
453 }
454 function TZUpdateSQL.GetModifySQL: TStrings;
455 begin
456  Result := FModifySQL;
457 end;
458 
459 {**
460  Sets a new Modify SQL statement.
461  @param Value a new Modify SQL statement.
462 }
463 procedure TZUpdateSQL.SetModifySQL(Value: TStrings);
464 begin
465  FModifySQL.Assign(Value);
466 end;
467 
468 {**
469  Updates all parameters.
470  @param Sender an event sender object.
471 }
472 procedure TZUpdateSQL.UpdateParams(Sender: TObject);
473 begin
474  RebuildAll;
475 end;
476 
477 {**
478  Rebuilds parameters and inserts a new one from specified sql statements.
479  @param SQLStrings a strings with SQL statements.
480 }
481 procedure TZUpdateSQL.Rebuild(SQLStrings: TZSQLStrings);
482 var
483  I: Integer;
484 begin
485  for I := 0 to SQLStrings.ParamCount - 1 do
486  begin
487  if FParams.FindParam(SQLStrings.ParamNames[I]) = nil then
488  FParams.CreateParam(ftUnknown, SQLStrings.ParamNames[I], ptUnknown);
489  end;
490 end;
491 
492 {**
493  Rebuilds all internal structures including parameters from SQL statements.
494 }
495 procedure TZUpdateSQL.RebuildAll;
496 var
497  OldParams: TParams;
498 begin
499  OldParams := TParams.Create;
500  OldParams.Assign(FParams);
501  FParams.Clear;
502  try
503  Rebuild(FModifySQL);
504  Rebuild(FInsertSQL);
505  Rebuild(FDeleteSQL);
506 //FOSPATCH
507  Rebuild(FRefreshSQL);
508 //FOSPATCH
509  FParams.AssignValues(OldParams);
510  finally
511  OldParams.Free;
512  end;
513 end;
514 
515 procedure TZUpdateSQL.RefreshCurrentRow(Sender: IZCachedResultSet; RowAccessor: TZRowAccessor);
516 var
517  Config: TZSQLStrings;
518  Statement: IZPreparedStatement;
519  RefreshResultSet: IZResultSet;
520 begin
521  Config:=FRefreshSQL;
522  if CONFIG.StatementCount=1 then
523  begin
524  Statement := Sender.GetStatement.GetConnection.PrepareStatement(Config.Statements[0].SQL);
525  FillStatement(Sender, Statement, Config.Statements[0],RowAccessor, RowAccessor);
526  RefreshResultSet:=Statement.ExecuteQueryPrepared;
527  Apply_RefreshResultSet(Sender,RefreshResultSet,RowAccessor);
528  end;
529 end;
530 
531 {**
532  Fills the specified statement with stored or given parameters.
533  @param ResultSet a source result set object.
534  @param Statement a DBC statement object.
535  @param Config a SQLStatement configuration.
536  @param OldRowAccessor an accessor object to old column values.
537  @param NewRowAccessor an accessor object to new column values.
538 }
539 procedure TZUpdateSQL.FillStatement(ResultSet: IZCachedResultSet;
540  Statement: IZPreparedStatement; Config: TZSQLStatement;
541  OldRowAccessor, NewRowAccessor: TZRowAccessor);
542 var
543  I, ColumnIndex: Integer;
544  ParamValue: TParam;
545  ParamName: string;
546  OldParam: Boolean;
547  WasNull: Boolean;
548  RowAccessor: TZRowAccessor;
549  TempBlob: IZBlob;
550 begin
551  WasNull := False;
552  for I := 0 to Config.ParamCount - 1 do
553  begin
554  ParamValue := Params.FindParam(Config.ParamNames[I]);
555  ParamName := Config.ParamNames[I];
556  OldParam := False;{Seqparam:=False;}
557  if StrLIComp(PChar(ParamName), 'NEW_', 4) = 0 then
558  begin
559  ParamName := Copy(ParamName, 5, Length(ParamName) - 4)
560  end
561  else if StrLIComp(PChar(ParamName), 'OLD_', 4) = 0 then
562  begin
563  ParamName := Copy(ParamName, 5, Length(ParamName) - 4);
564  OldParam := True;
565  end;
566 
567  ColumnIndex := ResultSet.FindColumn(ParamName);
568  if ColumnIndex > 0 then
569  begin
570  if OldParam then
571  RowAccessor := OldRowAccessor
572  else
573  RowAccessor := NewRowAccessor;
574 
575  if StrToBoolEx(DefineStatementParameter(
576  ResultSet.GetStatement, 'defaults', 'true')) then
577  Statement.SetDefaultValue(I + 1,
578  ResultSet.GetMetadata.GetDefaultValue(ColumnIndex));
579 
580  case ResultSet.GetMetadata.GetColumnType(ColumnIndex) of
581  stBoolean:
582  Statement.SetBoolean(I + 1,
583  RowAccessor.GetBoolean(ColumnIndex, WasNull));
584  stByte:
585  Statement.SetByte(I + 1, RowAccessor.GetByte(ColumnIndex, WasNull));
586  stShort:
587  Statement.SetShort(I + 1, RowAccessor.GetShort(ColumnIndex, WasNull));
588  stInteger:
589  Statement.SetInt(I + 1, RowAccessor.GetInt(ColumnIndex, WasNull));
590  stLong:
591  Statement.SetLong(I + 1, RowAccessor.GetLong(ColumnIndex, WasNull));
592  stFloat:
593  Statement.SetFloat(I + 1, RowAccessor.GetFloat(ColumnIndex, WasNull));
594  stDouble:
595  Statement.SetDouble(I + 1, RowAccessor.GetDouble(ColumnIndex, WasNull));
596  stBigDecimal:
597  Statement.SetBigDecimal(I + 1,
598  RowAccessor.GetBigDecimal(ColumnIndex, WasNull));
599  stString:
600  Statement.SetString(I + 1, RowAccessor.GetString(ColumnIndex, WasNull)); //smells like DataLoss
601  stUnicodeString:
602  Statement.SetUnicodeString(I + 1, RowAccessor.GetUnicodeString(ColumnIndex, WasNull));
603  stBytes:
604  Statement.SetBytes(I + 1, RowAccessor.GetBytes(ColumnIndex, WasNull));
605  stDate:
606  Statement.SetDate(I + 1, RowAccessor.GetDate(ColumnIndex, WasNull));
607  stTime:
608  Statement.SetTime(I + 1, RowAccessor.GetTime(ColumnIndex, WasNull));
609  stTimestamp:
610  Statement.SetTimestamp(I + 1,
611  RowAccessor.GetTimestamp(ColumnIndex, WasNull));
612  stAsciiStream:
613  begin
614  TempBlob := RowAccessor.GetBlob(ColumnIndex, WasNull);
615  if not TempBlob.IsEmpty then
616  Statement.SetBlob(I + 1, stAsciiStream, TempBlob)
617  else
618  Statement.SetNull(I + 1, stAsciiStream);
619  end;
620  stUnicodeStream:
621  begin
622  TempBlob := RowAccessor.GetBlob(ColumnIndex, WasNull);
623  if not TempBlob.IsEmpty then
624  Statement.SetBlob(I + 1, stUnicodeStream, TempBlob)
625  else
626  Statement.SetNull(I + 1, stUnicodeStream);
627  end;
628  stBinaryStream:
629  begin
630  TempBlob := RowAccessor.GetBlob(ColumnIndex, WasNull);
631  if not TempBlob.IsEmpty then
632  Statement.SetBlob(I + 1, stBinaryStream, TempBlob)
633  else
634  Statement.SetNull(I + 1, stBinaryStream);
635  end;
636  end;
637  if WasNull then
638  begin
639  Statement.SetNull(I + 1,
640  ResultSet.GetMetadata.GetColumnType(ColumnIndex))
641  end;
642  end
643  else
644  SetStatementParam(I+1, Statement, ParamValue);
645  end;
646 end;
647 
648 {**
649  Apply the Refreshed values.
650  @param RefreshResultSet a result set object.
651  @param RefreshRowAccessor an accessor object to column values.
652 }
653 
654 procedure TZUpdateSQL.Apply_RefreshResultSet(const Sender:IZCachedResultSet;
655  const RefreshResultSet: IZResultSet; const RefreshRowAccessor: TZRowAccessor);
656 var
657  I: Integer;
658  RefreshColumnIndex:integer;
659  RefreshColumnName:String;
660  RefreshColumnType:TZSQLType;
661 
662 Label CheckColumnType;
663 begin
664  if Assigned(RefreshResultSet) then begin
665  if (RefreshResultSet.GetType = rtForwardOnly) then
666  begin
667  if not RefreshResultSet.Next then
668  raise EZDatabaseError.Create(SUpdateSQLNoResult);
669  end
670  else if not (RefreshResultSet.GetType = rtForwardOnly) and not RefreshResultSet.First then
671  raise EZDatabaseError.Create(SUpdateSQLNoResult);
672  for I := 1 to RefreshResultSet.GetMetadata.GetColumnCount do begin
673  RefreshColumnName:=RefreshResultSet.GetMetadata.GetColumnLabel(I); // What Column from Resultset should be updated
674  RefreshColumnIndex := Sender.FindColumn(RefreshColumnName); // Is the Column available in the select ?
675  if RefreshColumnIndex=0 then begin
676  continue; // Column not found in Select from Dataset
677  end;
678  if RefreshResultSet.IsNull(I) then begin
679  RefreshRowAccessor.SetNull(RefreshColumnIndex);
680  end else begin
681  RefreshColumnType := RefreshResultSet.GetMetadata.GetColumnType(I); // Type of Column ?
682 CheckColumnType:
683  case RefreshColumnType of
684  stBoolean: RefreshRowAccessor.SetBoolean(RefreshColumnIndex, RefreshResultSet.GetBoolean(I));
685  stByte: RefreshRowAccessor.SetByte(RefreshColumnIndex, RefreshResultSet.GetByte(I));
686  stShort: RefreshRowAccessor.SetShort(RefreshColumnIndex, RefreshResultSet.GetShort(I));
687  stInteger: RefreshRowAccessor.SetInt(RefreshColumnIndex, RefreshResultSet.GetInt(I));
688  stLong: RefreshRowAccessor.SetLong(RefreshColumnIndex, RefreshResultSet.GetLong(I));
689  stFloat: RefreshRowAccessor.SetFloat(RefreshColumnIndex, RefreshResultSet.GetFloat(I));
690  stDouble: RefreshRowAccessor.SetDouble(RefreshColumnIndex, RefreshResultSet.GetDouble(I));
691  stBigDecimal: RefreshRowAccessor.SetBigDecimal(RefreshColumnIndex, RefreshResultSet.GetBigDecimal(I));
692  // gto: do we need PChar here?
693  //stString: RefreshRowAccessor.SetPChar(RefreshColumnIndex, RefreshResultSet.GetPChar(I));
694  stString: RefreshRowAccessor.SetString(RefreshColumnIndex, String(RefreshResultSet.GetString(I)));
695  stUnicodeString: RefreshRowAccessor.SetUnicodeString(RefreshColumnIndex, RefreshResultSet.GetUnicodeString(I));
696  stBytes: RefreshRowAccessor.SetBytes(RefreshColumnIndex, RefreshResultSet.GetBytes(I));
697  stDate: RefreshRowAccessor.SetDate(RefreshColumnIndex, RefreshResultSet.GetDate(I));
698  stTime: RefreshRowAccessor.SetTime(RefreshColumnIndex, RefreshResultSet.GetTime(I));
699  stTimestamp: RefreshRowAccessor.SetTimestamp(RefreshColumnIndex, RefreshResultSet.GetTimestamp(I));
700  stAsciiStream, stUnicodeStream, stBinaryStream:
701  {handle possible different column_type using a native RS
702  e.g. SQLite with joins we get stream types for string/bytes etc. coulmns
703  because SQLite sadly doesn't retrieve ColunmType infos
704  All conversion can be made by RowAccessor but not the lob-columns!}
705  if RefreshRowAccessor.GetColumnType(RefreshColumnIndex) in [stAsciiStream, stUnicodeStream, stBinaryStream] then
706  RefreshRowAccessor.SetBlob(RefreshColumnIndex, RefreshResultSet.GetBlob(I))
707  else
708  begin
709  RefreshColumnType := RefreshRowAccessor.GetColumnType(RefreshColumnIndex);
710  goto CheckColumnType;
711  end;
712  end;
713  end;
714  end;
715  end;
716 end;
717 {**
718  Calculate default values for the fields.
719  @param Sender a cached result set object.
720  @param RowAccessor an accessor object to column values.
721 }
722 
723 procedure TZUpdateSQL.CalculateDefaults(Sender: IZCachedResultSet;
724  RowAccessor: TZRowAccessor);
725 begin
726  {BEGIN PATCH [1214009] TZUpdateSQL - implemented feature to Calculate default values}
727  Sender.GetNativeResolver.CalculateDefaults(Sender, RowAccessor);
728  {END PATCH [1214009] TZUpdateSQL - implemented feature to Calculate default values}
729 end;
730 
731 {**
732  Posts updates to database.
733  @param Sender a cached result set object.
734  @param UpdateType a type of updates.
735  @param OldRowAccessor an accessor object to old column values.
736  @param NewRowAccessor an accessor object to new column values.
737 }
738 procedure TZUpdateSQL.PostUpdates(Sender: IZCachedResultSet;
739  UpdateType: TZRowUpdateType; OldRowAccessor, NewRowAccessor: TZRowAccessor);
740 var
741  I: Integer;
742  Statement: IZPreparedStatement;
743  Config: TZSQLStrings;
744  CalcDefaultValues,
745  ExecuteStatement,
746  UpdateAutoIncFields: Boolean;
747  Refresh_OldSQL:String;
748  RefreshResultSet: IZResultSet;
749  lValidateUpdateCount : Boolean;
750  lUpdateCount : Integer;
751 begin
752  if (UpdateType = utDeleted)
753  and (OldRowAccessor.RowBuffer.UpdateType = utInserted) then
754  Exit;
755 
756  case UpdateType of
757  utInserted:
758  Config := FInsertSQL;
759  utDeleted:
760  Config := FDeleteSQL;
761  utModified:
762  Config := FModifySQL;
763  else
764  Exit;
765  end;
766 
767  case UpdateType of
768  utInserted:
769  DoBeforeInsertSQL;
770  utDeleted:
771  DoBeforeDeleteSQL;
772  utModified:
773  DoBeforeModifySQL;
774  end;
775 
776  if Dataset is TZAbstractRODataset then
777  (Dataset as TZAbstractRODataset).Connection.ShowSqlHourGlass;
778  CalcDefaultValues :=
779  ZSysUtils.StrToBoolEx(DefineStatementParameter(Sender.GetStatement,'defaults','true'));
780  try
781  for I := 0 to Config.StatementCount - 1 do
782  begin
783  Statement := Sender.GetStatement.GetConnection.
784  PrepareStatement(Config.Statements[I].SQL);
785  FillStatement(Sender, Statement, Config.Statements[I],
786  OldRowAccessor, NewRowAccessor);
787  {BEGIN of PATCH [1185969]: Do tasks after posting updates. ie: Updating AutoInc fields in MySQL }
788  {Update AutoInc Field Tasks will be only executed if the UpdateAutoIncFields
789  in the AfterInsertSQLStatement event returns true
790  }
791  ExecuteStatement := true;
792  UpdateAutoIncFields := false;
793  case UpdateType of
794  utDeleted: DoBeforeDeleteSQLStatement(Self, I, ExecuteStatement);
795  utInserted: DoBeforeInsertSQLStatement(Self, I, ExecuteStatement);
796  utModified: DoBeforeModifySQLStatement(Self, I, ExecuteStatement);
797  end;
798  if ExecuteStatement then
799  begin
800  // if Property ValidateUpdateCount isn't set : assume it's true
801  lValidateUpdateCount := (Sender.GetStatement.GetParameters.IndexOfName('ValidateUpdateCount') = -1)
802  or StrToBoolEx(Sender.GetStatement.GetParameters.Values['ValidateUpdateCount']);
803 
804  lUpdateCount := Statement.ExecuteUpdatePrepared;
805  {$IFDEF WITH_VALIDATE_UPDATE_COUNT}
806  if (lValidateUpdateCount) and (lUpdateCount <> 1 ) then
807  raise EZSQLException.Create(Format(SInvalidUpdateCount, [lUpdateCount]));
808  {$ENDIF}
809 
810  case UpdateType of
811  utDeleted: DoAfterDeleteSQLStatement(Self, I);
812  utInserted:
813  begin
814  DoAfterInsertSQLStatement(Self, I, UpdateAutoIncFields);
815  if CalcDefaultValues and UpdateAutoIncFields then
816  UpdateAutoIncrementFields(Sender, UpdateType,
817  OldRowAccessor, NewRowAccessor, Self);
818  end;
819  utModified: DoAfterModifySQLStatement(Self,I);
820  end;
821  end;
822  {END of PATCH [1185969]: Do tasks after posting updates. ie: Updating AutoInc fields in MySQL }
823  end;
824 //FOSPATCH
825  case UpdateType of
826  utInserted,utModified: begin
827  if FRefreshSql.Text<>'' then begin
828  Refresh_OldSQL:=FRefreshSql.Text;
829  try
830  Config:=FRefreshSQL;
831  if UpdateType=utInserted then begin
832  if Dataset is TZAbstractDataset then begin
833  if FUseSequenceFieldForRefreshSQL then begin
834  if assigned(TZAbstractDataset(DataSet).Sequence) and (TZAbstractDataset(DataSet).SequenceField<>'') then begin
835  Config.Text :=
836  StringReplace(UpperCase(Config.Text),
837  ':OLD_'+UpperCase(TZAbstractDataset(DataSet).SequenceField),
838  TZAbstractDataset(DataSet).Sequence.GetCurrentValueSQL,[rfReplaceAll]);
839  end;
840  end;
841  end;
842  end;
843  if CONFIG.StatementCount=1 then begin
844  Statement := Sender.GetStatement.GetConnection.PrepareStatement(Config.Statements[0].SQL);
845  FillStatement(Sender, Statement, Config.Statements[0],OldRowAccessor, NewRowAccessor);
846  RefreshResultSet:=Statement.ExecuteQueryPrepared;
847  Apply_RefreshResultSet(Sender,RefreshResultSet,NewRowAccessor);
848  end;
849  finally
850  FRefreshSQL.Text:=Refresh_OldSQL;
851  end;
852  end;
853  end;
854  end;
855 //FOSPATCH
856 
857  finally
858  if Dataset is TZAbstractRODataset then
859  (Dataset as TZAbstractRODataset).Connection.HideSQLHourGlass;
860  end;
861 
862  case UpdateType of
863  utInserted: DoAfterInsertSQL;
864  utDeleted: DoAfterDeleteSQL;
865  utModified: DoAfterModifySQL;
866  end;
867 end;
868 
869 {**
870  Fires an event before delete Statement
871 }
872 procedure TZUpdateSQL.DoBeforeDeleteSQL;
873 begin
874  if Assigned(FBeforeDeleteSQL) then
875  FBeforeDeleteSQL(Self);
876 end;
877 
878 {**
879  Fires an event before insert Statement
880 }
881 procedure TZUpdateSQL.DoBeforeInsertSQL;
882 begin
883  if Assigned(BeforeInsertSQL) then
884  FBeforeInsertSQL(Self);
885 end;
886 
887 {**
888  Fires an event before modify Statement
889 }
890 procedure TZUpdateSQL.DoBeforeModifySQL;
891 begin
892  if Assigned(FBeforeModifySQL) then
893  FBeforeModifySQL(Self);
894 end;
895 
896 {**
897  Fires an event after delete Statement
898 }
899 procedure TZUpdateSQL.DoAfterDeleteSQL;
900 begin
901  if Assigned(FAfterDeleteSQL) then
902  FAfterDeleteSQL(Self);
903 end;
904 
905 {**
906  Fires an event after insert Statement
907 }
908 procedure TZUpdateSQL.DoAfterInsertSQL;
909 begin
910  if Assigned(FAfterInsertSQL) then
911  FAfterInsertSQL(Self);
912 end;
913 
914 {**
915  Fires an event after modify Statement
916 }
917 procedure TZUpdateSQL.DoAfterModifySQL;
918 begin
919  if Assigned(FAfterModifySQL) then
920  FAfterModifySQL(Self);
921 end;
922 
923 {BEGIN of PATCH [1185969]: Do tasks after posting updates. ie: Updating AutoInc fields in MySQL }
924 procedure TZUpdateSQL.UpdateAutoIncrementFields(Sender: IZCachedResultSet;
925  UpdateType: TZRowUpdateType; OldRowAccessor,
926  NewRowAccessor: TZRowAccessor; Resolver: IZCachedResolver);
927 begin
928  with Sender.GetNativeResolver do
929  begin
930  UpdateAutoIncrementFields(Sender, UpdateType,
931  OldRowAccessor, NewRowAccessor, Resolver);
932  end;
933 end;
934 {END of PATCH [1185969]: Do tasks after posting updates. ie: Updating AutoInc fields in MySQL }
935 
936 {NEW Methods for Events to validate at Statement level }
937 procedure TZUpdateSQL.DoAfterDeleteSQLStatement(const Sender: TObject;
938  StatementIndex: Integer);
939 begin
940  if Assigned(FAfterDeleteSQLStatement) then
941  FAfterDeleteSQLStatement(Self, StatementIndex);
942 end;
943 
944 procedure TZUpdateSQL.DoAfterInsertSQLStatement(const Sender: TObject;
945  StatementIndex: Integer; out UpdateAutoIncFields: Boolean);
946 begin
947  if Assigned(FAfterInsertSQLStatement) then
948  FAfterInsertSQLStatement(Self, StatementIndex, UpdateAutoIncFields);
949 end;
950 
951 procedure TZUpdateSQL.DoAfterModifySQLStatement(const Sender: TObject;
952  StatementIndex: Integer);
953 begin
954  if Assigned(FAfterModifySQLStatement) then
955  FAfterModifySQLStatement(Self, StatementIndex);
956 end;
957 
958 procedure TZUpdateSQL.DoBeforeDeleteSQLStatement(const Sender: TObject;
959  StatementIndex: Integer; out Execute: Boolean);
960 begin
961  if Assigned(FBeforeDeleteSQLStatement) then
962  FBeforeDeleteSQLStatement(Self, StatementIndex, Execute);
963 end;
964 
965 procedure TZUpdateSQL.DoBeforeInsertSQLStatement(const Sender: TObject;
966  StatementIndex: Integer; out Execute: Boolean);
967 begin
968  if Assigned(FBeforeInsertSQLStatement) then
969  FBeforeInsertSQLStatement(Self, StatementIndex, Execute);
970 end;
971 
972 procedure TZUpdateSQL.DoBeforeModifySQLStatement(const Sender: TObject;
973  StatementIndex: Integer; out Execute: Boolean);
974 begin
975  if Assigned(FBeforeModifySQLStatement) then
976  FBeforeModifySQLStatement(Self, StatementIndex, Execute);
977 end;
978 
979 end.