ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/nongui/IBUpdate.pas
Revision: 410
Committed: Thu Jun 22 13:52:39 2023 UTC (16 months, 3 weeks ago) by tony
Content type: text/x-pascal
File size: 20999 byte(s)
Log Message:
Release 2.6.0 beta

File Contents

# Content
1 (*
2 * IBX For Lazarus (Firebird Express)
3 *
4 * The contents of this file are subject to the Initial Developer's
5 * Public License Version 1.0 (the "License"); you may not use this
6 * file except in compliance with the License. You may obtain a copy
7 * of the License here:
8 *
9 * http://www.firebirdsql.org/index.php?op=doc&id=idpl
10 *
11 * Software distributed under the License is distributed on an "AS
12 * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
13 * implied. See the License for the specific language governing rights
14 * and limitations under the License.
15 *
16 * The Initial Developer of the Original Code is Tony Whyman.
17 *
18 * The Original Code is (C) 2015-2020 Tony Whyman, MWA Software
19 * (http://www.mwasoftware.co.uk).
20 *
21 * All Rights Reserved.
22 *
23 * Contributor(s): ______________________________________.
24 *
25 *)
26
27 unit IBUpdate;
28
29 {$mode objfpc}{$H+}
30
31 interface
32
33 uses
34 Classes, SysUtils, IBCustomDataSet, DB, IB, IBDatabase, IBExternals, IBMessages;
35
36 type
37
38 TOnApplyUpdates = procedure(Sender: TObject; UpdateKind: TUpdateKind; Params: ISQLParams) of object;
39
40 { TIBUpdate}
41
42 TIBUpdate = class(TIBDataSetUpdateObject)
43 private
44 FDummySQL: TStrings;
45 FOnApplyUpdates: TOnApplyUpdates;
46 protected
47 function GetSQL(UpdateKind: TUpdateKind): TStrings; override;
48 procedure Apply(UpdateKind: TUpdateKind; buff: TRecordBuffer); override;
49 public
50 constructor Create(AOwner: TComponent); override;
51 destructor Destroy; override;
52 property DataSet;
53 published
54 property OnApplyUpdates: TOnApplyUpdates read FOnApplyUpdates write FOnApplyUpdates;
55 end;
56
57
58 implementation
59
60 uses variants, FmtBCD, DateUtils, FBNumeric;
61
62 type
63
64 { TParamListIntf }
65
66 TParamListIntf = class(TInterfacedObject,ISQLParams)
67 private
68 type TParamRec = record
69 Name: string;
70 Value: variant;
71 Modified: boolean;
72 TimeZoneID: TFBTimeZoneID;
73 DataSet: TDataSet;
74 end;
75 private
76 FDatabase: TIBDatabase;
77 FModified: boolean;
78 FParams: array of TParamRec;
79 procedure SetParam(index: integer; aValue: variant);
80 procedure SetTimeZoneID(index: integer; aValue: TFBTimeZoneID);
81 public
82 constructor Create(aFields: TFields; aDatabase: TIBDatabase);
83 destructor Destroy; override;
84 property Database: TIBDatabase read FDatabase;
85 public
86 {ISQLParams}
87 function getCount: integer;
88 function getSQLParam(index: integer): ISQLParam;
89 function ParamExists(Idx: AnsiString): boolean;
90 function ByName(Idx: AnsiString): ISQLParam ;
91 function GetModified: Boolean;
92 function GetHasCaseSensitiveParams: Boolean;
93 function GetStatement: IStatement;
94 function GetTransaction: ITransaction;
95 function GetAttachment: IAttachment;
96 procedure Clear;
97 end;
98
99 { TParamIntf }
100
101 TParamIntf = class(TInterfacedObject,ISQLParam)
102 private
103 FIndex: integer;
104 FOwner: TParamListIntf;
105 function GetDataSet: TDataSet;
106 public
107 constructor Create(aOwner: TParamListIntf; aIndex: integer);
108 function getColMetadata: IParamMetaData;
109 function GetIndex: integer;
110 function GetSQLType: cardinal;
111 function GetSQLTypeName: AnsiString;
112 function getSubtype: integer;
113 function getName: AnsiString;
114 function getScale: integer;
115 function getCharSetID: cardinal;
116 function getCodePage: TSystemCodePage;
117 function getIsNullable: boolean;
118 function GetSize: cardinal;
119 function GetAsBoolean: boolean;
120 function GetAsCurrency: Currency;
121 function GetAsInt64: Int64;
122 function GetAsDateTime: TDateTime; overload;
123 procedure GetAsDateTime(var aDateTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID); overload;
124 procedure GetAsDateTime(var aDateTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString); overload;
125 procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID; OnDate: TDateTime); overload;
126 procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString; OnDate: TDateTime); overload;
127 procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID); overload;
128 procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString); overload;
129 function GetAsUTCDateTime: TDateTime;
130 function GetAsDouble: Double;
131 function GetAsFloat: Float;
132 function GetAsLong: Long;
133 function GetAsPointer: Pointer;
134 function GetAsQuad: TISC_QUAD;
135 function GetAsShort: short;
136 function GetAsString: AnsiString;
137 function GetIsNull: boolean;
138 function GetAsVariant: Variant;
139 function GetAsBlob: IBlob;
140 function GetAsArray: IArray;
141 function GetAsBCD: tBCD;
142 function GetAsNumeric: IFBNumeric;
143 function GetStatement: IStatement;
144 function GetTransaction: ITransaction;
145 function GetAttachment: IAttachment;
146 procedure Clear;
147 function GetModified: boolean;
148 procedure SetAsBoolean(AValue: boolean);
149 procedure SetAsCurrency(aValue: Currency);
150 procedure SetAsInt64(aValue: Int64);
151 procedure SetAsDate(aValue: TDateTime);
152 procedure SetAsLong(aValue: Long);
153 procedure SetAsTime(aValue: TDateTime); overload;
154 procedure SetAsTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
155 procedure SetAsTime(aValue: TDateTime; aTimeZone: AnsiString); overload;
156 procedure SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
157 procedure SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString); overload;
158 procedure SetAsDateTime(aValue: TDateTime); overload;
159 procedure SetAsDateTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
160 procedure SetAsDateTime(aValue: TDateTime; aTimeZone: AnsiString); overload;
161 procedure SetAsUTCDateTime(aUTCTime: TDateTime);
162 procedure SetAsDouble(aValue: Double);
163 procedure SetAsFloat(aValue: Float);
164 procedure SetAsPointer(aValue: Pointer);
165 procedure SetAsShort(aValue: Short);
166 procedure SetAsString(aValue: AnsiString);
167 procedure SetAsVariant(aValue: Variant);
168 procedure SetIsNull(aValue: Boolean);
169 procedure SetAsBlob(aValue: IBlob);
170 procedure SetAsArray(anArray: IArray);
171 procedure SetAsQuad(aValue: TISC_QUAD);
172 procedure SetCharSetID(aValue: cardinal);
173 procedure SetAsBcd(aValue: tBCD);
174 procedure SetAsNumeric(Value: IFBNumeric);
175 end;
176
177 { TParamIntf }
178
179 function TParamIntf.GetDataSet: TDataSet;
180 begin
181 Result := FOwner.FParams[FIndex].DataSet;
182 end;
183
184 constructor TParamIntf.Create(aOwner: TParamListIntf; aIndex: integer);
185 begin
186 FOwner := aOwner;
187 FIndex := aIndex;
188 end;
189
190 function TParamIntf.getColMetadata: IParamMetaData;
191 begin
192 IBError(ibxeNotSupported,[]);
193 end;
194
195 function TParamIntf.GetIndex: integer;
196 begin
197 Result := Findex;
198 end;
199
200 function TParamIntf.GetSQLType: cardinal;
201 begin
202 IBError(ibxeNotSupported,[]);
203 end;
204
205 function TParamIntf.GetSQLTypeName: AnsiString;
206 begin
207 IBError(ibxeNotSupported,[]);
208 end;
209
210 function TParamIntf.getSubtype: integer;
211 begin
212 IBError(ibxeNotSupported,[]);
213 end;
214
215 function TParamIntf.getName: AnsiString;
216 begin
217 Result := FOwner.FParams[FIndex].Name;
218 end;
219
220 function TParamIntf.getScale: integer;
221 begin
222 IBError(ibxeNotSupported,[]);
223 end;
224
225 function TParamIntf.getCharSetID: cardinal;
226 var id: integer;
227 begin
228 FOwner.Database.Attachment.CodePage2CharSetID(StringCodePage(FOwner.FParams[FIndex].Value),id);
229 Result := id;
230 end;
231
232 function TParamIntf.getCodePage: TSystemCodePage;
233 begin
234 Result := StringCodePage(FOwner.FParams[FIndex].Value);
235 end;
236
237 function TParamIntf.getIsNullable: boolean;
238 begin
239 Result := true;
240 end;
241
242 function TParamIntf.GetSize: cardinal;
243 begin
244 IBError(ibxeNotSupported,[]);
245 end;
246
247 function TParamIntf.GetAsBoolean: boolean;
248 begin
249 if VarIsNull(FOwner.FParams[FIndex].Value) then
250 Result := false
251 else
252 Result := FOwner.FParams[FIndex].Value;
253 end;
254
255 function TParamIntf.GetAsCurrency: Currency;
256 begin
257 Result := FOwner.FParams[FIndex].Value;
258 end;
259
260 function TParamIntf.GetAsInt64: Int64;
261 begin
262 Result := FOwner.FParams[FIndex].Value;
263 end;
264
265 function TParamIntf.GetAsDateTime: TDateTime;
266 begin
267 Result := FOwner.FParams[FIndex].Value;
268 end;
269
270 procedure TParamIntf.GetAsDateTime(var aDateTime: TDateTime;
271 var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID);
272 begin
273 with FOwner.FParams[FIndex] do
274 if VarIsArray(Value) then
275 begin
276 aDateTime := Value[0];
277 dstOffset := Value[1];
278 if VarType(Value[2]) in [varSmallint, varInteger, varByte, varWord, varShortInt] then
279 aTimezoneID := Value[2]
280 else
281 aTimeZoneID := FOwner.DataBase.attachment.GetTimeZoneServices.TimeZoneName2TimeZoneID(Value[2]);
282 end
283 else
284 begin
285 aDateTime := FOwner.FParams[FIndex].Value;
286 dstOffset := 0;
287 aTimeZoneID := TimeZoneID_GMT;
288 end;
289 end;
290
291 procedure TParamIntf.GetAsDateTime(var aDateTime: TDateTime;
292 var dstOffset: smallint; var aTimezone: AnsiString);
293 begin
294 with FOwner.FParams[FIndex] do
295 if VarIsArray(Value) then
296 begin
297 aDateTime := Value[0];
298 dstOffset := Value[1];
299 if VarType(Value[2]) in [varSmallint, varInteger, varByte, varWord, varShortInt] then
300 aTimeZone := FOwner.DataBase.attachment.GetTimeZoneServices.TimeZoneID2TimeZoneName(Value[2])
301 else
302 aTimezone := Value[2];
303 end
304 else
305 begin
306 aDateTime := FOwner.FParams[FIndex].Value;
307 dstOffset := 0;
308 aTimeZone := 'GMT';
309 end;
310 end;
311
312 procedure TParamIntf.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
313 var aTimezoneID: TFBTimeZoneID; OnDate: TDateTime);
314 var LocalTime: TDateTime;
315 begin
316 with FOwner.FParams[FIndex] do
317 if VarIsArray(Value) then
318 begin
319 LocalTime := OnDate + TimeOf(Value[0]);
320 dstOffset := Value[1];
321 if VarType(Value[2]) in [varSmallint, varInteger, varByte, varWord, varShortInt] then
322 aTimezoneID := Value[2]
323 else
324 aTimeZoneID := FOwner.DataBase.attachment.GetTimeZoneServices.TimeZoneName2TimeZoneID(Value[2]);
325 aTime := TimeOf(FOwner.DataBase.attachment.GetTimeZoneServices.GMTToLocalTime(IncMinute(LocalTime,-dstOffset),aTimeZoneID))
326 end
327 else
328 begin
329 aTime := FOwner.FParams[FIndex].Value;
330 dstOffset := 0;
331 aTimeZoneID := TimeZoneID_GMT;
332 end;
333 end;
334
335 procedure TParamIntf.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
336 var aTimezone: AnsiString; OnDate: TDateTime);
337 var LocalTime: TDateTime;
338 begin
339 with FOwner.FParams[FIndex] do
340 if VarIsArray(Value) then
341 begin
342 LocalTime := OnDate + TimeOf(Value[0]);
343 dstOffset := Value[1];
344 if VarType(Value[2]) in [varSmallint, varInteger, varByte, varWord, varShortInt] then
345 aTimeZone := FOwner.DataBase.attachment.GetTimeZoneServices.TimeZoneID2TimeZoneName(Value[2])
346 else
347 aTimezone := Value[2];
348 aTime := TimeOf(FOwner.DataBase.attachment.GetTimeZoneServices.GMTToLocalTime(IncMinute(LocalTime,-dstOffset),aTimeZone))
349 end
350 else
351 begin
352 aTime := FOwner.FParams[FIndex].Value;
353 dstOffset := 0;
354 aTimeZone := 'GMT';
355 end;
356 end;
357
358 procedure TParamIntf.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
359 var aTimezoneID: TFBTimeZoneID);
360 begin
361 GetAsTime(aTime,dstOffset,aTimeZoneID,(GetDataSet as TIBCustomDataSet).DefaultTZDate);
362 end;
363
364 procedure TParamIntf.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
365 var aTimezone: AnsiString);
366 begin
367 GetAsTime(aTime,dstOffset,aTimeZone,(GetDataSet as TIBCustomDataSet).DefaultTZDate);
368 end;
369
370 function TParamIntf.GetAsUTCDateTime: TDateTime;
371 begin
372 with FOwner.FParams[FIndex] do
373 if VarIsArray(Value) then
374 Result := IncMinute(Value[0],-Value[1])
375 else
376 Result := FOwner.FParams[FIndex].Value;
377 end;
378
379 function TParamIntf.GetAsDouble: Double;
380 begin
381 Result := FOwner.FParams[FIndex].Value;
382 end;
383
384 function TParamIntf.GetAsFloat: Float;
385 begin
386 Result := FOwner.FParams[FIndex].Value;
387 end;
388
389 function TParamIntf.GetAsLong: Long;
390 begin
391 Result := FOwner.FParams[FIndex].Value;
392 end;
393
394 function TParamIntf.GetAsPointer: Pointer;
395 begin
396 IBError(ibxeNotSupported,[]);
397 end;
398
399 function TParamIntf.GetAsQuad: TISC_QUAD;
400 begin
401 IBError(ibxeNotSupported,[]);
402 end;
403
404 function TParamIntf.GetAsShort: short;
405 begin
406 Result := FOwner.FParams[FIndex].Value;
407 end;
408
409 function TParamIntf.GetAsString: AnsiString;
410 var v: variant;
411 begin
412 v := FOwner.FParams[FIndex].Value;
413 Case varType(v) of
414 varEmpty,
415 varNull:
416 Result := '';
417 varShortInt,
418 varSmallint,
419 varInteger,
420 varInt64,
421 varByte,
422 varWord,
423 varDecimal,
424 varLongWord,
425 varQWord,
426 varSingle:
427 Result := IntToStr(v);
428 varCurrency,
429 varDouble:
430 Result := FloatToStr(v);
431 varDate:
432 Result := DateTimeToStr(v);
433 varStrArg,
434 varString:
435 Result := v;
436 varBoolean:
437 if v then
438 Result := 'true'
439 else
440 Result := 'false';
441 varVariant:
442 Result := v;
443 else
444 Result := v;
445 end;
446 end;
447
448 function TParamIntf.GetIsNull: boolean;
449 begin
450 Result := VarIsNull(FOwner.FParams[FIndex].Value);
451 end;
452
453 function TParamIntf.GetAsVariant: Variant;
454 begin
455 Result := FOwner.FParams[FIndex].Value;
456 end;
457
458 function TParamIntf.GetAsBlob: IBlob;
459 begin
460 IBError(ibxeNotSupported,[]);
461 end;
462
463 function TParamIntf.GetAsArray: IArray;
464 begin
465 IBError(ibxeNotSupported,[]);
466 end;
467
468 function TParamIntf.GetAsBCD: tBCD;
469 begin
470 Result := VarToBCD(FOwner.FParams[FIndex].Value);
471 end;
472
473 function TParamIntf.GetAsNumeric: IFBNumeric;
474 begin
475 IBError(ibxeNotSupported,[]);
476 end;
477
478 function TParamIntf.GetStatement: IStatement;
479 begin
480 IBError(ibxeNotSupported,[]);
481 end;
482
483 function TParamIntf.GetTransaction: ITransaction;
484 begin
485 IBError(ibxeNotSupported,[]);
486 end;
487
488 function TParamIntf.GetAttachment: IAttachment;
489 begin
490 IBError(ibxeNotSupported,[]);
491 end;
492
493 procedure TParamIntf.Clear;
494 begin
495 FOwner.SetParam(FIndex,NULL);
496 end;
497
498 function TParamIntf.GetModified: boolean;
499 begin
500 Result := FOwner.FParams[FIndex].Modified;
501 end;
502
503 procedure TParamIntf.SetAsBoolean(AValue: boolean);
504 begin
505 FOwner.SetParam(FIndex,AValue);
506 end;
507
508 procedure TParamIntf.SetAsCurrency(aValue: Currency);
509 begin
510 FOwner.SetParam(FIndex,AValue);
511 end;
512
513 procedure TParamIntf.SetAsInt64(aValue: Int64);
514 begin
515 FOwner.SetParam(FIndex,AValue);
516 end;
517
518 procedure TParamIntf.SetAsDate(aValue: TDateTime);
519 begin
520 FOwner.SetParam(FIndex,AValue);
521 end;
522
523 procedure TParamIntf.SetAsLong(aValue: Long);
524 begin
525 FOwner.SetParam(FIndex,AValue);
526 end;
527
528 procedure TParamIntf.SetAsTime(aValue: TDateTime);
529 begin
530 FOwner.SetParam(FIndex,AValue);
531 end;
532
533 procedure TParamIntf.SetAsTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID);
534 begin
535 SetAsTime(aValue,(GetDataSet as TIBCustomDataSet).DefaultTZDate,aTimeZoneID);
536 end;
537
538 procedure TParamIntf.SetAsTime(aValue: TDateTime; aTimeZone: AnsiString);
539 begin
540 SetAsTime(aValue,(GetDataSet as TIBCustomDataSet).DefaultTZDate,aTimeZone);
541 end;
542
543 procedure TParamIntf.SetAsTime(aValue: TDateTime; OnDate: TDateTime;
544 aTimeZoneID: TFBTimeZoneID);
545 var dstOffset: smallint;
546 begin
547 aValue := TimeOf(aValue);
548 dstOffset := FOwner.Database.Attachment.GetTimeZoneServices.GetEffectiveOffsetMins(OnDate + aValue,aTimeZoneID);
549 FOwner.SetParam(FIndex,VarArrayOf([aValue,dstOffset,aTimeZoneID]));
550 end;
551
552 procedure TParamIntf.SetAsTime(aValue: TDateTime; OnDate: TDateTime;
553 aTimeZone: AnsiString);
554 var dstOffset: smallint;
555 begin
556 aValue := TimeOf(aValue);
557 dstOffset := FOwner.Database.Attachment.GetTimeZoneServices.GetEffectiveOffsetMins(OnDate + aValue,aTimeZone);
558 FOwner.SetParam(FIndex,VarArrayOf([aValue,dstOffset,aTimeZone]));
559 end;
560
561 procedure TParamIntf.SetAsDateTime(aValue: TDateTime);
562 begin
563 FOwner.SetParam(FIndex,AValue);
564 end;
565
566 procedure TParamIntf.SetAsDateTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID
567 );
568 var dstOffset: smallint;
569 begin
570 with FOwner.DataBase.attachment.GetTimeZoneServices do
571 begin
572 dstOffset := GetEffectiveOffsetMins(aValue,aTimeZoneID);
573 FOwner.SetParam(FIndex,VarArrayOf([aValue,aTimeZoneID]));
574 end;
575 end;
576
577 procedure TParamIntf.SetAsDateTime(aValue: TDateTime; aTimeZone: AnsiString);
578 var dstOffset: smallint;
579 begin
580 with FOwner.DataBase.attachment.GetTimeZoneServices do
581 begin
582 dstOffset := GetEffectiveOffsetMins(aValue,aTimeZone);
583 FOwner.SetParam(FIndex,VarArrayOf([aValue,aTimeZone]));
584 end;
585 end;
586
587 procedure TParamIntf.SetAsUTCDateTime(aUTCTime: TDateTime);
588 begin
589 IBError(ibxeNotSupported,[]);
590 end;
591
592 procedure TParamIntf.SetAsDouble(aValue: Double);
593 begin
594 FOwner.SetParam(FIndex,AValue);
595 end;
596
597 procedure TParamIntf.SetAsFloat(aValue: Float);
598 begin
599 FOwner.SetParam(FIndex,AValue);
600 end;
601
602 procedure TParamIntf.SetAsPointer(aValue: Pointer);
603 begin
604 IBError(ibxeNotSupported,[]);
605 end;
606
607 procedure TParamIntf.SetAsShort(aValue: Short);
608 begin
609 FOwner.SetParam(FIndex,AValue);
610 end;
611
612 procedure TParamIntf.SetAsString(aValue: AnsiString);
613 begin
614 FOwner.SetParam(FIndex,AValue);
615 end;
616
617 procedure TParamIntf.SetAsVariant(aValue: Variant);
618 begin
619 FOwner.SetParam(FIndex,AValue);
620 end;
621
622 procedure TParamIntf.SetIsNull(aValue: Boolean);
623 begin
624 if aValue then
625 FOwner.SetParam(FIndex,NULL)
626 end;
627
628 procedure TParamIntf.SetAsBlob(aValue: IBlob);
629 begin
630 IBError(ibxeNotSupported,[]);
631 end;
632
633 procedure TParamIntf.SetAsArray(anArray: IArray);
634 begin
635 IBError(ibxeNotSupported,[]);
636 end;
637
638 procedure TParamIntf.SetAsQuad(aValue: TISC_QUAD);
639 begin
640 IBError(ibxeNotSupported,[]);
641 end;
642
643 procedure TParamIntf.SetCharSetID(aValue: cardinal);
644 var s: RawByteString;
645 codepage: TSystemCodePage;
646 str: string;
647 begin
648 str := FOwner.FParams[FIndex].Value;
649 s := str;
650 if FOwner.Database.Attachment.CharSetID2CodePage(aValue,codepage) then
651 SetCodePage(s,codepage,codepage <> cp_none);
652 end;
653
654 procedure TParamIntf.SetAsBcd(aValue: tBCD);
655 begin
656 FOwner.SetParam(FIndex,VarFmtBCDCreate(AValue));
657 end;
658
659 procedure TParamIntf.SetAsNumeric(Value: IFBNumeric);
660 begin
661 IBError(ibxeNotSupported,[]);
662 end;
663
664 { TParamListIntf }
665
666 procedure TParamListIntf.SetParam(index: integer; aValue: variant);
667 begin
668 FParams[index].Value := aValue;
669 FParams[index].Modified := true;
670 FParams[index].TimeZoneID := TimeZoneID_GMT;
671 FModified := true;
672 end;
673
674 procedure TParamListIntf.SetTimeZoneID(index: integer; aValue: TFBTimeZoneID);
675 begin
676 if FParams[index].Modified then
677 FParams[index].TimeZoneID := aValue;
678 end;
679
680 constructor TParamListIntf.Create(aFields: TFields; aDatabase: TIBDatabase);
681 var i,j: integer;
682 begin
683 inherited Create;
684 FDatabase := aDatabase;
685 SetLength(FParams,aFields.Count*2);
686 j := 0;
687 {set up both current and "OLD" parameters from Field Names}
688 for i := 0 to aFields.Count - 1 do
689 if aFields[i].FieldKind = fkData then
690 begin
691 FParams[j].Name := aFields[i].FieldName;
692 FParams[j].Value := NULL;
693 FParams[j].Modified := false;
694 FParams[j].DataSet := aFields[i].DataSet;
695 Inc(j);
696 FParams[j].Name := 'OLD_' + aFields[i].FieldName;
697 FParams[j].Value := NULL;
698 FParams[j].Modified := false;
699 FParams[j].DataSet := aFields[i].DataSet;
700 Inc(j);
701 end;
702 SetLength(FParams,j);
703 end;
704
705 destructor TParamListIntf.Destroy;
706 begin
707 SetLength(FParams,0);
708 inherited Destroy;
709 end;
710
711 function TParamListIntf.getCount: integer;
712 begin
713 Result := Length(FParams);
714 end;
715
716 function TParamListIntf.getSQLParam(index: integer): ISQLParam;
717 begin
718 if (index < 0) or (index >= getCount) then
719 IBError(ibxeInvalidColumnIndex,[nil]);
720 Result := TParamIntf.Create(self,index);
721 end;
722
723 function TParamListIntf.ParamExists(Idx: AnsiString): boolean;
724 begin
725 Result := ByName(Idx) <> nil;
726 end;
727
728 function TParamListIntf.ByName(Idx: AnsiString): ISQLParam;
729 var i: integer;
730 begin
731 Result := nil;
732 for i := 0 to getCount - 1 do
733 if CompareText(FParams[i].Name,Idx) = 0 then
734 begin
735 Result := getSQLParam(i);
736 Exit;
737 end;
738 end;
739
740 function TParamListIntf.GetModified: Boolean;
741 begin
742 Result := FModified;
743 end;
744
745 function TParamListIntf.GetHasCaseSensitiveParams: Boolean;
746 begin
747 Result := false;
748 end;
749
750 function TParamListIntf.GetStatement: IStatement;
751 begin
752 IBError(ibxeNotSupported,[]);
753 end;
754
755 function TParamListIntf.GetTransaction: ITransaction;
756 begin
757 IBError(ibxeNotSupported,[]);
758 end;
759
760 function TParamListIntf.GetAttachment: IAttachment;
761 begin
762 Result := Database.Attachment;
763 end;
764
765 procedure TParamListIntf.Clear;
766 var i: integer;
767 begin
768 for i := 0 to getCount - 1 do
769 getSQLParam(i).Clear;
770 end;
771
772 { TIBUpdate }
773
774 function TIBUpdate.GetSQL(UpdateKind: TUpdateKind): TStrings;
775 begin
776 Result := FDummySQL; {non empty result}
777 end;
778
779 procedure TIBUpdate.Apply(UpdateKind: TUpdateKind; buff: TRecordBuffer);
780 var Params: ISQLParams;
781 begin
782 Params := TParamListIntf.Create(Dataset.Fields,(DataSet.Database as TIBDatabase));
783 InternalSetParams(Params,buff);
784 if assigned(FOnApplyUpdates) then
785 OnApplyUpdates(self,UpdateKind,Params);
786 end;
787
788 constructor TIBUpdate.Create(AOwner: TComponent);
789 begin
790 inherited Create(AOwner);
791 FDummySQL := TStringList.Create;
792 FDummySQL.Text := '*';
793 end;
794
795 destructor TIBUpdate.Destroy;
796 begin
797 if assigned(FDummySQL) then FDummySQL.Free;
798 inherited Destroy;
799 end;
800
801 end.
802

Properties

Name Value
svn:eol-style native