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

# User Rev Content
1 tony 209 (*
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 tony 315 * The Original Code is (C) 2015-2020 Tony Whyman, MWA Software
19 tony 209 * (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 tony 291 Classes, SysUtils, IBCustomDataSet, DB, IB, IBDatabase, IBExternals, IBMessages;
35 tony 209
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 tony 410 procedure Apply(UpdateKind: TUpdateKind; buff: TRecordBuffer); override;
49 tony 209 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 tony 402 uses variants, FmtBCD, DateUtils, FBNumeric;
61 tony 209
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 tony 315 TimeZoneID: TFBTimeZoneID;
73     DataSet: TDataSet;
74 tony 209 end;
75     private
76     FDatabase: TIBDatabase;
77     FModified: boolean;
78     FParams: array of TParamRec;
79     procedure SetParam(index: integer; aValue: variant);
80 tony 315 procedure SetTimeZoneID(index: integer; aValue: TFBTimeZoneID);
81 tony 209 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 tony 402 function ParamExists(Idx: AnsiString): boolean;
90 tony 209 function ByName(Idx: AnsiString): ISQLParam ;
91     function GetModified: Boolean;
92 tony 287 function GetHasCaseSensitiveParams: Boolean;
93 tony 402 function GetStatement: IStatement;
94     function GetTransaction: ITransaction;
95     function GetAttachment: IAttachment;
96     procedure Clear;
97 tony 209 end;
98    
99     { TParamIntf }
100    
101     TParamIntf = class(TInterfacedObject,ISQLParam)
102     private
103     FIndex: integer;
104     FOwner: TParamListIntf;
105 tony 315 function GetDataSet: TDataSet;
106 tony 209 public
107     constructor Create(aOwner: TParamListIntf; aIndex: integer);
108 tony 349 function getColMetadata: IParamMetaData;
109 tony 209 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 tony 315 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 tony 209 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 tony 315 function GetAsBCD: tBCD;
142 tony 402 function GetAsNumeric: IFBNumeric;
143 tony 315 function GetStatement: IStatement;
144     function GetTransaction: ITransaction;
145 tony 402 function GetAttachment: IAttachment;
146 tony 209 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 tony 315 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 tony 209 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 tony 315 procedure SetAsBcd(aValue: tBCD);
174 tony 402 procedure SetAsNumeric(Value: IFBNumeric);
175 tony 209 end;
176    
177     { TParamIntf }
178    
179 tony 315 function TParamIntf.GetDataSet: TDataSet;
180     begin
181     Result := FOwner.FParams[FIndex].DataSet;
182     end;
183    
184 tony 209 constructor TParamIntf.Create(aOwner: TParamListIntf; aIndex: integer);
185     begin
186     FOwner := aOwner;
187     FIndex := aIndex;
188     end;
189    
190 tony 349 function TParamIntf.getColMetadata: IParamMetaData;
191     begin
192     IBError(ibxeNotSupported,[]);
193     end;
194    
195 tony 209 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 tony 410 if VarIsNull(FOwner.FParams[FIndex].Value) then
250     Result := false
251     else
252     Result := FOwner.FParams[FIndex].Value;
253 tony 209 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 tony 315 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 tony 209 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 tony 315 function TParamIntf.GetAsBCD: tBCD;
469     begin
470     Result := VarToBCD(FOwner.FParams[FIndex].Value);
471     end;
472    
473 tony 402 function TParamIntf.GetAsNumeric: IFBNumeric;
474     begin
475     IBError(ibxeNotSupported,[]);
476     end;
477    
478 tony 315 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 tony 402 function TParamIntf.GetAttachment: IAttachment;
489     begin
490     IBError(ibxeNotSupported,[]);
491     end;
492    
493 tony 209 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 tony 315 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 tony 209 procedure TParamIntf.SetAsDateTime(aValue: TDateTime);
562     begin
563     FOwner.SetParam(FIndex,AValue);
564     end;
565    
566 tony 315 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 tony 209 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 tony 315 procedure TParamIntf.SetAsBcd(aValue: tBCD);
655     begin
656     FOwner.SetParam(FIndex,VarFmtBCDCreate(AValue));
657     end;
658    
659 tony 402 procedure TParamIntf.SetAsNumeric(Value: IFBNumeric);
660     begin
661     IBError(ibxeNotSupported,[]);
662     end;
663    
664 tony 209 { TParamListIntf }
665    
666     procedure TParamListIntf.SetParam(index: integer; aValue: variant);
667     begin
668     FParams[index].Value := aValue;
669     FParams[index].Modified := true;
670 tony 315 FParams[index].TimeZoneID := TimeZoneID_GMT;
671 tony 209 FModified := true;
672     end;
673    
674 tony 315 procedure TParamListIntf.SetTimeZoneID(index: integer; aValue: TFBTimeZoneID);
675     begin
676     if FParams[index].Modified then
677     FParams[index].TimeZoneID := aValue;
678     end;
679    
680 tony 209 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 tony 315 FParams[j].DataSet := aFields[i].DataSet;
695 tony 209 Inc(j);
696     FParams[j].Name := 'OLD_' + aFields[i].FieldName;
697     FParams[j].Value := NULL;
698     FParams[j].Modified := false;
699 tony 315 FParams[j].DataSet := aFields[i].DataSet;
700 tony 209 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 tony 402 function TParamListIntf.ParamExists(Idx: AnsiString): boolean;
724     begin
725     Result := ByName(Idx) <> nil;
726     end;
727    
728 tony 209 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 tony 287 function TParamListIntf.GetHasCaseSensitiveParams: Boolean;
746     begin
747     Result := false;
748     end;
749    
750 tony 402 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 tony 209 { TIBUpdate }
773    
774     function TIBUpdate.GetSQL(UpdateKind: TUpdateKind): TStrings;
775     begin
776     Result := FDummySQL; {non empty result}
777     end;
778    
779 tony 410 procedure TIBUpdate.Apply(UpdateKind: TUpdateKind; buff: TRecordBuffer);
780 tony 209 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