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 349 by tony, Mon Oct 18 08:39:40 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 getColMetadata: IParamMetaData;
107      function GetIndex: integer;
108      function GetSQLType: cardinal;
109      function GetSQLTypeName: AnsiString;
# Line 111 | Line 117 | type
117      function GetAsBoolean: boolean;
118      function GetAsCurrency: Currency;
119      function GetAsInt64: Int64;
120 <    function GetAsDateTime: TDateTime;
120 >    function GetAsDateTime: TDateTime; overload;
121 >    procedure GetAsDateTime(var aDateTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID); overload;
122 >    procedure GetAsDateTime(var aDateTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString); overload;
123 >    procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID; OnDate: TDateTime); overload;
124 >    procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString; OnDate: TDateTime); overload;
125 >    procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID); overload;
126 >    procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString); overload;
127 >    function GetAsUTCDateTime: TDateTime;
128      function GetAsDouble: Double;
129      function GetAsFloat: Float;
130      function GetAsLong: Long;
# Line 123 | Line 136 | type
136      function GetAsVariant: Variant;
137      function GetAsBlob: IBlob;
138      function GetAsArray: IArray;
139 +    function GetAsBCD: tBCD;
140 +    function GetStatement: IStatement;
141 +    function GetTransaction: ITransaction;
142      procedure Clear;
143      function GetModified: boolean;
144      procedure SetAsBoolean(AValue: boolean);
# Line 130 | Line 146 | type
146      procedure SetAsInt64(aValue: Int64);
147      procedure SetAsDate(aValue: TDateTime);
148      procedure SetAsLong(aValue: Long);
149 <    procedure SetAsTime(aValue: TDateTime);
150 <    procedure SetAsDateTime(aValue: TDateTime);
149 >    procedure SetAsTime(aValue: TDateTime); overload;
150 >    procedure SetAsTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
151 >    procedure SetAsTime(aValue: TDateTime; aTimeZone: AnsiString); overload;
152 >    procedure SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
153 >    procedure SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString); overload;
154 >    procedure SetAsDateTime(aValue: TDateTime); overload;
155 >    procedure SetAsDateTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
156 >    procedure SetAsDateTime(aValue: TDateTime; aTimeZone: AnsiString); overload;
157 >    procedure SetAsUTCDateTime(aUTCTime: TDateTime);
158      procedure SetAsDouble(aValue: Double);
159      procedure SetAsFloat(aValue: Float);
160      procedure SetAsPointer(aValue: Pointer);
# Line 143 | Line 166 | type
166      procedure SetAsArray(anArray: IArray);
167      procedure SetAsQuad(aValue: TISC_QUAD);
168      procedure SetCharSetID(aValue: cardinal);
169 +    procedure SetAsBcd(aValue: tBCD);
170    end;
171  
172   { TParamIntf }
173  
174 + function TParamIntf.GetDataSet: TDataSet;
175 + begin
176 +  Result := FOwner.FParams[FIndex].DataSet;
177 + end;
178 +
179   constructor TParamIntf.Create(aOwner: TParamListIntf; aIndex: integer);
180   begin
181    FOwner := aOwner;
182    FIndex := aIndex;
183   end;
184  
185 + function TParamIntf.getColMetadata: IParamMetaData;
186 + begin
187 +  IBError(ibxeNotSupported,[]);
188 + end;
189 +
190   function TParamIntf.GetIndex: integer;
191   begin
192    Result := Findex;
# Line 225 | Line 259 | begin
259    Result := FOwner.FParams[FIndex].Value;
260   end;
261  
262 + procedure TParamIntf.GetAsDateTime(var aDateTime: TDateTime;
263 +  var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID);
264 + begin
265 +  with FOwner.FParams[FIndex] do
266 +  if VarIsArray(Value) then
267 +  begin
268 +    aDateTime := Value[0];
269 +    dstOffset := Value[1];
270 +    if VarType(Value[2]) in [varSmallint, varInteger, varByte, varWord, varShortInt] then
271 +      aTimezoneID := Value[2]
272 +    else
273 +      aTimeZoneID := FOwner.DataBase.attachment.GetTimeZoneServices.TimeZoneName2TimeZoneID(Value[2]);
274 +  end
275 +  else
276 +  begin
277 +    aDateTime := FOwner.FParams[FIndex].Value;
278 +    dstOffset := 0;
279 +    aTimeZoneID := TimeZoneID_GMT;
280 +  end;
281 + end;
282 +
283 + procedure TParamIntf.GetAsDateTime(var aDateTime: TDateTime;
284 +  var dstOffset: smallint; var aTimezone: AnsiString);
285 + begin
286 +  with FOwner.FParams[FIndex] do
287 +  if VarIsArray(Value) then
288 +  begin
289 +    aDateTime := Value[0];
290 +    dstOffset := Value[1];
291 +    if VarType(Value[2]) in [varSmallint, varInteger, varByte, varWord, varShortInt] then
292 +      aTimeZone := FOwner.DataBase.attachment.GetTimeZoneServices.TimeZoneID2TimeZoneName(Value[2])
293 +    else
294 +      aTimezone := Value[2];
295 +  end
296 +  else
297 +  begin
298 +    aDateTime := FOwner.FParams[FIndex].Value;
299 +    dstOffset := 0;
300 +    aTimeZone := 'GMT';
301 +  end;
302 + end;
303 +
304 + procedure TParamIntf.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
305 +  var aTimezoneID: TFBTimeZoneID; OnDate: TDateTime);
306 + var LocalTime: TDateTime;
307 + begin
308 +  with FOwner.FParams[FIndex] do
309 +  if VarIsArray(Value) then
310 +  begin
311 +    LocalTime := OnDate + TimeOf(Value[0]);
312 +    dstOffset := Value[1];
313 +    if VarType(Value[2]) in [varSmallint, varInteger, varByte, varWord, varShortInt] then
314 +      aTimezoneID := Value[2]
315 +    else
316 +      aTimeZoneID := FOwner.DataBase.attachment.GetTimeZoneServices.TimeZoneName2TimeZoneID(Value[2]);
317 +    aTime := TimeOf(FOwner.DataBase.attachment.GetTimeZoneServices.GMTToLocalTime(IncMinute(LocalTime,-dstOffset),aTimeZoneID))
318 +  end
319 +  else
320 +  begin
321 +    aTime := FOwner.FParams[FIndex].Value;
322 +    dstOffset := 0;
323 +    aTimeZoneID := TimeZoneID_GMT;
324 +  end;
325 + end;
326 +
327 + procedure TParamIntf.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
328 +  var aTimezone: AnsiString; OnDate: TDateTime);
329 + var LocalTime: TDateTime;
330 + begin
331 +  with FOwner.FParams[FIndex] do
332 +  if VarIsArray(Value) then
333 +  begin
334 +    LocalTime := OnDate + TimeOf(Value[0]);
335 +    dstOffset := Value[1];
336 +    if VarType(Value[2]) in [varSmallint, varInteger, varByte, varWord, varShortInt] then
337 +      aTimeZone := FOwner.DataBase.attachment.GetTimeZoneServices.TimeZoneID2TimeZoneName(Value[2])
338 +    else
339 +      aTimezone := Value[2];
340 +    aTime := TimeOf(FOwner.DataBase.attachment.GetTimeZoneServices.GMTToLocalTime(IncMinute(LocalTime,-dstOffset),aTimeZone))
341 +  end
342 +  else
343 +  begin
344 +    aTime := FOwner.FParams[FIndex].Value;
345 +    dstOffset := 0;
346 +    aTimeZone := 'GMT';
347 +  end;
348 + end;
349 +
350 + procedure TParamIntf.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
351 +  var aTimezoneID: TFBTimeZoneID);
352 + begin
353 +  GetAsTime(aTime,dstOffset,aTimeZoneID,(GetDataSet as TIBCustomDataSet).DefaultTZDate);
354 + end;
355 +
356 + procedure TParamIntf.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
357 +  var aTimezone: AnsiString);
358 + begin
359 +  GetAsTime(aTime,dstOffset,aTimeZone,(GetDataSet as TIBCustomDataSet).DefaultTZDate);
360 + end;
361 +
362 + function TParamIntf.GetAsUTCDateTime: TDateTime;
363 + begin
364 +  with FOwner.FParams[FIndex] do
365 +  if VarIsArray(Value) then
366 +    Result := IncMinute(Value[0],-Value[1])
367 +  else
368 +    Result := FOwner.FParams[FIndex].Value;
369 + end;
370 +
371   function TParamIntf.GetAsDouble: Double;
372   begin
373    Result := FOwner.FParams[FIndex].Value;
# Line 314 | Line 457 | begin
457    IBError(ibxeNotSupported,[]);
458   end;
459  
460 + function TParamIntf.GetAsBCD: tBCD;
461 + begin
462 +  Result := VarToBCD(FOwner.FParams[FIndex].Value);
463 + end;
464 +
465 + function TParamIntf.GetStatement: IStatement;
466 + begin
467 +  IBError(ibxeNotSupported,[]);
468 + end;
469 +
470 + function TParamIntf.GetTransaction: ITransaction;
471 + begin
472 +  IBError(ibxeNotSupported,[]);
473 + end;
474 +
475   procedure TParamIntf.Clear;
476   begin
477    FOwner.SetParam(FIndex,NULL);
# Line 354 | Line 512 | begin
512    FOwner.SetParam(FIndex,AValue);
513   end;
514  
515 + procedure TParamIntf.SetAsTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID);
516 + begin
517 +  SetAsTime(aValue,(GetDataSet as TIBCustomDataSet).DefaultTZDate,aTimeZoneID);
518 + end;
519 +
520 + procedure TParamIntf.SetAsTime(aValue: TDateTime; aTimeZone: AnsiString);
521 + begin
522 +  SetAsTime(aValue,(GetDataSet as TIBCustomDataSet).DefaultTZDate,aTimeZone);
523 + end;
524 +
525 + procedure TParamIntf.SetAsTime(aValue: TDateTime; OnDate: TDateTime;
526 +  aTimeZoneID: TFBTimeZoneID);
527 + var dstOffset: smallint;
528 + begin
529 +  aValue := TimeOf(aValue);
530 +  dstOffset := FOwner.Database.Attachment.GetTimeZoneServices.GetEffectiveOffsetMins(OnDate + aValue,aTimeZoneID);
531 +  FOwner.SetParam(FIndex,VarArrayOf([aValue,dstOffset,aTimeZoneID]));
532 + end;
533 +
534 + procedure TParamIntf.SetAsTime(aValue: TDateTime; OnDate: TDateTime;
535 +  aTimeZone: AnsiString);
536 + var dstOffset: smallint;
537 + begin
538 +  aValue := TimeOf(aValue);
539 +  dstOffset := FOwner.Database.Attachment.GetTimeZoneServices.GetEffectiveOffsetMins(OnDate + aValue,aTimeZone);
540 +  FOwner.SetParam(FIndex,VarArrayOf([aValue,dstOffset,aTimeZone]));
541 + end;
542 +
543   procedure TParamIntf.SetAsDateTime(aValue: TDateTime);
544   begin
545    FOwner.SetParam(FIndex,AValue);
546   end;
547  
548 + procedure TParamIntf.SetAsDateTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID
549 +  );
550 + var dstOffset: smallint;
551 + begin
552 +  with FOwner.DataBase.attachment.GetTimeZoneServices do
553 +  begin
554 +    dstOffset := GetEffectiveOffsetMins(aValue,aTimeZoneID);
555 +    FOwner.SetParam(FIndex,VarArrayOf([aValue,aTimeZoneID]));
556 +  end;
557 + end;
558 +
559 + procedure TParamIntf.SetAsDateTime(aValue: TDateTime; aTimeZone: AnsiString);
560 + var dstOffset: smallint;
561 + begin
562 +  with FOwner.DataBase.attachment.GetTimeZoneServices do
563 +  begin
564 +    dstOffset := GetEffectiveOffsetMins(aValue,aTimeZone);
565 +    FOwner.SetParam(FIndex,VarArrayOf([aValue,aTimeZone]));
566 +  end;
567 + end;
568 +
569 + procedure TParamIntf.SetAsUTCDateTime(aUTCTime: TDateTime);
570 + begin
571 +  IBError(ibxeNotSupported,[]);
572 + end;
573 +
574   procedure TParamIntf.SetAsDouble(aValue: Double);
575   begin
576    FOwner.SetParam(FIndex,AValue);
# Line 421 | Line 633 | begin
633      SetCodePage(s,codepage,codepage <> cp_none);
634   end;
635  
636 + procedure TParamIntf.SetAsBcd(aValue: tBCD);
637 + begin
638 +  FOwner.SetParam(FIndex,VarFmtBCDCreate(AValue));
639 + end;
640 +
641   { TParamListIntf }
642  
643   procedure TParamListIntf.SetParam(index: integer; aValue: variant);
644   begin
645    FParams[index].Value := aValue;
646    FParams[index].Modified := true;
647 +  FParams[index].TimeZoneID := TimeZoneID_GMT;
648    FModified := true;
649   end;
650  
651 + procedure TParamListIntf.SetTimeZoneID(index: integer; aValue: TFBTimeZoneID);
652 + begin
653 +  if FParams[index].Modified then
654 +    FParams[index].TimeZoneID := aValue;
655 + end;
656 +
657   constructor TParamListIntf.Create(aFields: TFields; aDatabase: TIBDatabase);
658   var i,j: integer;
659   begin
# Line 444 | Line 668 | begin
668      FParams[j].Name := aFields[i].FieldName;
669      FParams[j].Value := NULL;
670      FParams[j].Modified := false;
671 +    FParams[j].DataSet := aFields[i].DataSet;
672      Inc(j);
673      FParams[j].Name := 'OLD_' + aFields[i].FieldName;
674      FParams[j].Value := NULL;
675      FParams[j].Modified := false;
676 +    FParams[j].DataSet := aFields[i].DataSet;
677      Inc(j);
678    end;
679    SetLength(FParams,j);
# Line 488 | Line 714 | begin
714    Result := FModified;
715   end;
716  
717 + function TParamListIntf.GetHasCaseSensitiveParams: Boolean;
718 + begin
719 +  Result := false;
720 + end;
721 +
722   { TIBUpdate }
723  
724   function TIBUpdate.GetSQL(UpdateKind: TUpdateKind): TStrings;

Diff Legend

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