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 |
|