ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/nongui/IBUpdate.pas
(Generate patch)

Comparing ibx/trunk/runtime/nongui/IBUpdate.pas (file contents):
Revision 209 by tony, Wed Mar 14 12:48:51 2018 UTC vs.
Revision 315 by tony, Thu Feb 25 11:56:36 2021 UTC

# Line 15 | Line 15
15   *
16   *  The Initial Developer of the Original Code is Tony Whyman.
17   *
18 < *  The Original Code is (C) 2015 Tony Whyman, MWA Software
18 > *  The Original Code is (C) 2015-2020 Tony Whyman, MWA Software
19   *  (http://www.mwasoftware.co.uk).
20   *
21   *  All Rights Reserved.
# Line 31 | Line 31 | unit IBUpdate;
31   interface
32  
33   uses
34 <  Classes, SysUtils, IBCustomDataSet, DB, IB, IBDatabase, IBExternals, FBMessages;
34 >  Classes, SysUtils, IBCustomDataSet, DB, IB, IBDatabase, IBExternals, IBMessages;
35  
36   type
37  
# Line 60 | Line 60 | type
60  
61   implementation
62  
63 < uses variants;
63 > uses variants, FmtBCD, DateUtils;
64  
65   type
66  
# Line 72 | Line 72 | type
72        Name: string;
73        Value: variant;
74        Modified: boolean;
75 +      TimeZoneID: TFBTimeZoneID;
76 +      DataSet: TDataSet;
77      end;
78    private
79      FDatabase: TIBDatabase;
80      FModified: boolean;
81      FParams: array of TParamRec;
82      procedure SetParam(index: integer; aValue: variant);
83 +    procedure SetTimeZoneID(index: integer; aValue: TFBTimeZoneID);
84    public
85      constructor Create(aFields: TFields; aDatabase: TIBDatabase);
86      destructor Destroy; override;
# Line 88 | Line 91 | type
91      function getSQLParam(index: integer): ISQLParam;
92      function ByName(Idx: AnsiString): ISQLParam ;
93      function GetModified: Boolean;
94 +    function GetHasCaseSensitiveParams: Boolean;
95    end;
96  
97    { TParamIntf }
# Line 96 | Line 100 | type
100    private
101      FIndex: integer;
102      FOwner: TParamListIntf;
103 +    function GetDataSet: TDataSet;
104    public
105      constructor Create(aOwner: TParamListIntf; aIndex: integer);
106      function GetIndex: integer;
# Line 111 | Line 116 | type
116      function GetAsBoolean: boolean;
117      function GetAsCurrency: Currency;
118      function GetAsInt64: Int64;
119 <    function GetAsDateTime: TDateTime;
119 >    function GetAsDateTime: TDateTime; overload;
120 >    procedure GetAsDateTime(var aDateTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID); overload;
121 >    procedure GetAsDateTime(var aDateTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString); overload;
122 >    procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID; OnDate: TDateTime); overload;
123 >    procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString; OnDate: TDateTime); overload;
124 >    procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID); overload;
125 >    procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString); overload;
126 >    function GetAsUTCDateTime: TDateTime;
127      function GetAsDouble: Double;
128      function GetAsFloat: Float;
129      function GetAsLong: Long;
# Line 123 | Line 135 | type
135      function GetAsVariant: Variant;
136      function GetAsBlob: IBlob;
137      function GetAsArray: IArray;
138 +    function GetAsBCD: tBCD;
139 +    function GetStatement: IStatement;
140 +    function GetTransaction: ITransaction;
141      procedure Clear;
142      function GetModified: boolean;
143      procedure SetAsBoolean(AValue: boolean);
# Line 130 | Line 145 | type
145      procedure SetAsInt64(aValue: Int64);
146      procedure SetAsDate(aValue: TDateTime);
147      procedure SetAsLong(aValue: Long);
148 <    procedure SetAsTime(aValue: TDateTime);
149 <    procedure SetAsDateTime(aValue: TDateTime);
148 >    procedure SetAsTime(aValue: TDateTime); overload;
149 >    procedure SetAsTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
150 >    procedure SetAsTime(aValue: TDateTime; aTimeZone: AnsiString); overload;
151 >    procedure SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
152 >    procedure SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString); overload;
153 >    procedure SetAsDateTime(aValue: TDateTime); overload;
154 >    procedure SetAsDateTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
155 >    procedure SetAsDateTime(aValue: TDateTime; aTimeZone: AnsiString); overload;
156 >    procedure SetAsUTCDateTime(aUTCTime: TDateTime);
157      procedure SetAsDouble(aValue: Double);
158      procedure SetAsFloat(aValue: Float);
159      procedure SetAsPointer(aValue: Pointer);
# Line 143 | Line 165 | type
165      procedure SetAsArray(anArray: IArray);
166      procedure SetAsQuad(aValue: TISC_QUAD);
167      procedure SetCharSetID(aValue: cardinal);
168 +    procedure SetAsBcd(aValue: tBCD);
169    end;
170  
171   { TParamIntf }
172  
173 + function TParamIntf.GetDataSet: TDataSet;
174 + begin
175 +  Result := FOwner.FParams[FIndex].DataSet;
176 + end;
177 +
178   constructor TParamIntf.Create(aOwner: TParamListIntf; aIndex: integer);
179   begin
180    FOwner := aOwner;
# Line 225 | Line 253 | begin
253    Result := FOwner.FParams[FIndex].Value;
254   end;
255  
256 + procedure TParamIntf.GetAsDateTime(var aDateTime: TDateTime;
257 +  var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID);
258 + begin
259 +  with FOwner.FParams[FIndex] do
260 +  if VarIsArray(Value) then
261 +  begin
262 +    aDateTime := Value[0];
263 +    dstOffset := Value[1];
264 +    if VarType(Value[2]) in [varSmallint, varInteger, varByte, varWord, varShortInt] then
265 +      aTimezoneID := Value[2]
266 +    else
267 +      aTimeZoneID := FOwner.DataBase.attachment.GetTimeZoneServices.TimeZoneName2TimeZoneID(Value[2]);
268 +  end
269 +  else
270 +  begin
271 +    aDateTime := FOwner.FParams[FIndex].Value;
272 +    dstOffset := 0;
273 +    aTimeZoneID := TimeZoneID_GMT;
274 +  end;
275 + end;
276 +
277 + procedure TParamIntf.GetAsDateTime(var aDateTime: TDateTime;
278 +  var dstOffset: smallint; var aTimezone: AnsiString);
279 + begin
280 +  with FOwner.FParams[FIndex] do
281 +  if VarIsArray(Value) then
282 +  begin
283 +    aDateTime := Value[0];
284 +    dstOffset := Value[1];
285 +    if VarType(Value[2]) in [varSmallint, varInteger, varByte, varWord, varShortInt] then
286 +      aTimeZone := FOwner.DataBase.attachment.GetTimeZoneServices.TimeZoneID2TimeZoneName(Value[2])
287 +    else
288 +      aTimezone := Value[2];
289 +  end
290 +  else
291 +  begin
292 +    aDateTime := FOwner.FParams[FIndex].Value;
293 +    dstOffset := 0;
294 +    aTimeZone := 'GMT';
295 +  end;
296 + end;
297 +
298 + procedure TParamIntf.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
299 +  var aTimezoneID: TFBTimeZoneID; OnDate: TDateTime);
300 + var LocalTime: TDateTime;
301 + begin
302 +  with FOwner.FParams[FIndex] do
303 +  if VarIsArray(Value) then
304 +  begin
305 +    LocalTime := OnDate + TimeOf(Value[0]);
306 +    dstOffset := Value[1];
307 +    if VarType(Value[2]) in [varSmallint, varInteger, varByte, varWord, varShortInt] then
308 +      aTimezoneID := Value[2]
309 +    else
310 +      aTimeZoneID := FOwner.DataBase.attachment.GetTimeZoneServices.TimeZoneName2TimeZoneID(Value[2]);
311 +    aTime := TimeOf(FOwner.DataBase.attachment.GetTimeZoneServices.GMTToLocalTime(IncMinute(LocalTime,-dstOffset),aTimeZoneID))
312 +  end
313 +  else
314 +  begin
315 +    aTime := FOwner.FParams[FIndex].Value;
316 +    dstOffset := 0;
317 +    aTimeZoneID := TimeZoneID_GMT;
318 +  end;
319 + end;
320 +
321 + procedure TParamIntf.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
322 +  var aTimezone: AnsiString; OnDate: TDateTime);
323 + var LocalTime: TDateTime;
324 + begin
325 +  with FOwner.FParams[FIndex] do
326 +  if VarIsArray(Value) then
327 +  begin
328 +    LocalTime := OnDate + TimeOf(Value[0]);
329 +    dstOffset := Value[1];
330 +    if VarType(Value[2]) in [varSmallint, varInteger, varByte, varWord, varShortInt] then
331 +      aTimeZone := FOwner.DataBase.attachment.GetTimeZoneServices.TimeZoneID2TimeZoneName(Value[2])
332 +    else
333 +      aTimezone := Value[2];
334 +    aTime := TimeOf(FOwner.DataBase.attachment.GetTimeZoneServices.GMTToLocalTime(IncMinute(LocalTime,-dstOffset),aTimeZone))
335 +  end
336 +  else
337 +  begin
338 +    aTime := FOwner.FParams[FIndex].Value;
339 +    dstOffset := 0;
340 +    aTimeZone := 'GMT';
341 +  end;
342 + end;
343 +
344 + procedure TParamIntf.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
345 +  var aTimezoneID: TFBTimeZoneID);
346 + begin
347 +  GetAsTime(aTime,dstOffset,aTimeZoneID,(GetDataSet as TIBCustomDataSet).DefaultTZDate);
348 + end;
349 +
350 + procedure TParamIntf.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
351 +  var aTimezone: AnsiString);
352 + begin
353 +  GetAsTime(aTime,dstOffset,aTimeZone,(GetDataSet as TIBCustomDataSet).DefaultTZDate);
354 + end;
355 +
356 + function TParamIntf.GetAsUTCDateTime: TDateTime;
357 + begin
358 +  with FOwner.FParams[FIndex] do
359 +  if VarIsArray(Value) then
360 +    Result := IncMinute(Value[0],-Value[1])
361 +  else
362 +    Result := FOwner.FParams[FIndex].Value;
363 + end;
364 +
365   function TParamIntf.GetAsDouble: Double;
366   begin
367    Result := FOwner.FParams[FIndex].Value;
# Line 314 | Line 451 | begin
451    IBError(ibxeNotSupported,[]);
452   end;
453  
454 + function TParamIntf.GetAsBCD: tBCD;
455 + begin
456 +  Result := VarToBCD(FOwner.FParams[FIndex].Value);
457 + end;
458 +
459 + function TParamIntf.GetStatement: IStatement;
460 + begin
461 +  IBError(ibxeNotSupported,[]);
462 + end;
463 +
464 + function TParamIntf.GetTransaction: ITransaction;
465 + begin
466 +  IBError(ibxeNotSupported,[]);
467 + end;
468 +
469   procedure TParamIntf.Clear;
470   begin
471    FOwner.SetParam(FIndex,NULL);
# Line 354 | Line 506 | begin
506    FOwner.SetParam(FIndex,AValue);
507   end;
508  
509 + procedure TParamIntf.SetAsTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID);
510 + begin
511 +  SetAsTime(aValue,(GetDataSet as TIBCustomDataSet).DefaultTZDate,aTimeZoneID);
512 + end;
513 +
514 + procedure TParamIntf.SetAsTime(aValue: TDateTime; aTimeZone: AnsiString);
515 + begin
516 +  SetAsTime(aValue,(GetDataSet as TIBCustomDataSet).DefaultTZDate,aTimeZone);
517 + end;
518 +
519 + procedure TParamIntf.SetAsTime(aValue: TDateTime; OnDate: TDateTime;
520 +  aTimeZoneID: TFBTimeZoneID);
521 + var dstOffset: smallint;
522 + begin
523 +  aValue := TimeOf(aValue);
524 +  dstOffset := FOwner.Database.Attachment.GetTimeZoneServices.GetEffectiveOffsetMins(OnDate + aValue,aTimeZoneID);
525 +  FOwner.SetParam(FIndex,VarArrayOf([aValue,dstOffset,aTimeZoneID]));
526 + end;
527 +
528 + procedure TParamIntf.SetAsTime(aValue: TDateTime; OnDate: TDateTime;
529 +  aTimeZone: AnsiString);
530 + var dstOffset: smallint;
531 + begin
532 +  aValue := TimeOf(aValue);
533 +  dstOffset := FOwner.Database.Attachment.GetTimeZoneServices.GetEffectiveOffsetMins(OnDate + aValue,aTimeZone);
534 +  FOwner.SetParam(FIndex,VarArrayOf([aValue,dstOffset,aTimeZone]));
535 + end;
536 +
537   procedure TParamIntf.SetAsDateTime(aValue: TDateTime);
538   begin
539    FOwner.SetParam(FIndex,AValue);
540   end;
541  
542 + procedure TParamIntf.SetAsDateTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID
543 +  );
544 + var dstOffset: smallint;
545 + begin
546 +  with FOwner.DataBase.attachment.GetTimeZoneServices do
547 +  begin
548 +    dstOffset := GetEffectiveOffsetMins(aValue,aTimeZoneID);
549 +    FOwner.SetParam(FIndex,VarArrayOf([aValue,aTimeZoneID]));
550 +  end;
551 + end;
552 +
553 + procedure TParamIntf.SetAsDateTime(aValue: TDateTime; aTimeZone: AnsiString);
554 + var dstOffset: smallint;
555 + begin
556 +  with FOwner.DataBase.attachment.GetTimeZoneServices do
557 +  begin
558 +    dstOffset := GetEffectiveOffsetMins(aValue,aTimeZone);
559 +    FOwner.SetParam(FIndex,VarArrayOf([aValue,aTimeZone]));
560 +  end;
561 + end;
562 +
563 + procedure TParamIntf.SetAsUTCDateTime(aUTCTime: TDateTime);
564 + begin
565 +  IBError(ibxeNotSupported,[]);
566 + end;
567 +
568   procedure TParamIntf.SetAsDouble(aValue: Double);
569   begin
570    FOwner.SetParam(FIndex,AValue);
# Line 421 | Line 627 | begin
627      SetCodePage(s,codepage,codepage <> cp_none);
628   end;
629  
630 + procedure TParamIntf.SetAsBcd(aValue: tBCD);
631 + begin
632 +  FOwner.SetParam(FIndex,VarFmtBCDCreate(AValue));
633 + end;
634 +
635   { TParamListIntf }
636  
637   procedure TParamListIntf.SetParam(index: integer; aValue: variant);
638   begin
639    FParams[index].Value := aValue;
640    FParams[index].Modified := true;
641 +  FParams[index].TimeZoneID := TimeZoneID_GMT;
642    FModified := true;
643   end;
644  
645 + procedure TParamListIntf.SetTimeZoneID(index: integer; aValue: TFBTimeZoneID);
646 + begin
647 +  if FParams[index].Modified then
648 +    FParams[index].TimeZoneID := aValue;
649 + end;
650 +
651   constructor TParamListIntf.Create(aFields: TFields; aDatabase: TIBDatabase);
652   var i,j: integer;
653   begin
# Line 444 | Line 662 | begin
662      FParams[j].Name := aFields[i].FieldName;
663      FParams[j].Value := NULL;
664      FParams[j].Modified := false;
665 +    FParams[j].DataSet := aFields[i].DataSet;
666      Inc(j);
667      FParams[j].Name := 'OLD_' + aFields[i].FieldName;
668      FParams[j].Value := NULL;
669      FParams[j].Modified := false;
670 +    FParams[j].DataSet := aFields[i].DataSet;
671      Inc(j);
672    end;
673    SetLength(FParams,j);
# Line 488 | Line 708 | begin
708    Result := FModified;
709   end;
710  
711 + function TParamListIntf.GetHasCaseSensitiveParams: Boolean;
712 + begin
713 +  Result := false;
714 + end;
715 +
716   { TIBUpdate }
717  
718   function TIBUpdate.GetSQL(UpdateKind: TUpdateKind): TStrings;

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines