49 |
|
uses |
50 |
|
{$IFDEF WINDOWS } |
51 |
|
Windows, |
52 |
< |
{$ELSE} |
52 |
> |
{$ENDIF} |
53 |
> |
{$IFDEF UNIX} |
54 |
|
unix, |
55 |
|
{$ENDIF} |
56 |
< |
SysUtils, Classes, IBDatabase, IBExternals, IB, IBSQL, Db, |
57 |
< |
IBUtils, IBBlob, IBSQLParser, IBDatabaseInfo, fpTimer; |
57 |
< |
|
58 |
< |
const |
59 |
< |
BufferCacheSize = 1000; { Allocate cache in this many record chunks} |
60 |
< |
UniCache = 2; { Uni-directional cache is 2 records big } |
56 |
> |
SysUtils, Classes, IBDatabase, IBExternals, IBInternals, IB, IBSQL, Db, |
57 |
> |
IBUtils, IBBlob, IBSQLParser, IBDatabaseInfo; |
58 |
|
|
59 |
|
type |
60 |
|
TIBCustomDataSet = class; |
84 |
|
property RefreshSQL: TStrings read FRefreshSQL write SetRefreshSQL; |
85 |
|
end; |
86 |
|
|
90 |
– |
TBlobDataArray = array[0..0] of TIBBlobStream; |
91 |
– |
PBlobDataArray = ^TBlobDataArray; |
87 |
|
TIBArrayField = class; |
88 |
|
|
89 |
|
{ TIBArray } |
90 |
|
|
91 |
< |
{Wrapper class to support array cache in TIBCustomDataset and event handling} |
91 |
> |
{Wrapper class to support array cache in TIBCustomDataSet and event handling} |
92 |
|
|
93 |
|
TIBArray = class |
94 |
|
private |
102 |
|
property ArrayIntf: IArray read FArray; |
103 |
|
end; |
104 |
|
|
110 |
– |
TArrayDataArray = array [0..0] of TIBArray; |
111 |
– |
PArrayDataArray = ^TArrayDataArray; |
112 |
– |
|
113 |
– |
{ TIBCustomDataSet } |
114 |
– |
|
115 |
– |
TCachedUpdateStatus = ( |
116 |
– |
cusUnmodified, cusModified, cusInserted, |
117 |
– |
cusDeleted, cusUninserted |
118 |
– |
); |
119 |
– |
TIBDBKey = record |
120 |
– |
DBKey: array[0..7] of Byte; |
121 |
– |
end; |
122 |
– |
PIBDBKey = ^TIBDBKey; |
123 |
– |
|
124 |
– |
PFieldData = ^TFieldData; |
125 |
– |
TFieldData = record |
126 |
– |
fdIsNull: Boolean; |
127 |
– |
fdDataLength: Short; |
128 |
– |
end; |
129 |
– |
|
130 |
– |
PColumnData = ^TColumnData; |
131 |
– |
TColumnData = record |
132 |
– |
fdDataType: Short; |
133 |
– |
fdDataScale: Short; |
134 |
– |
fdNullable: Boolean; |
135 |
– |
fdDataSize: Short; |
136 |
– |
fdDataOfs: Integer; |
137 |
– |
fdCodePage: TSystemCodePage; |
138 |
– |
end; |
139 |
– |
|
140 |
– |
PFieldColumns = ^TFieldColumns; |
141 |
– |
TFieldColumns = array[1..1] of TColumnData; |
142 |
– |
|
143 |
– |
TRecordData = record |
144 |
– |
rdBookmarkFlag: TBookmarkFlag; |
145 |
– |
rdFieldCount: Short; |
146 |
– |
rdRecordNumber: Integer; |
147 |
– |
rdCachedUpdateStatus: TCachedUpdateStatus; |
148 |
– |
rdUpdateStatus: TUpdateStatus; |
149 |
– |
rdSavedOffset: DWORD; |
150 |
– |
rdDBKey: TIBDBKey; |
151 |
– |
rdFields: array[1..1] of TFieldData; |
152 |
– |
end; |
153 |
– |
PRecordData = ^TRecordData; |
154 |
– |
|
105 |
|
{ TIBArrayField } |
106 |
|
|
107 |
|
TIBArrayField = class(TField) |
243 |
|
property CodePage: TSystemCodePage read FFCodePage write FFCodePage; |
244 |
|
end; |
245 |
|
|
246 |
+ |
PIBBufferedDateTimeWithTimeZone = ^TIBBufferedDateTimeWithTimeZone; |
247 |
+ |
TIBBufferedDateTimeWithTimeZone = packed record |
248 |
+ |
Timestamp: TDateTime; |
249 |
+ |
dstOffset: smallint; |
250 |
+ |
TimeZoneID: ISC_USHORT; |
251 |
+ |
end; |
252 |
+ |
|
253 |
+ |
{ TIBDateTimeField } |
254 |
+ |
|
255 |
+ |
{It seems wrong to make this a subclass of TTimeField and not TDateTimField. |
256 |
+ |
However, the rationale is backwards compatibility for applications that |
257 |
+ |
may want to coerce a TField to a TTimeField. If this is to work then |
258 |
+ |
TIBTimeField has to descend from TTimeField. Hence the declation. As |
259 |
+ |
TTimeField also descends from TDateTimeField this should not result in any |
260 |
+ |
problems - unless someone makes a drastic change to TTimeField.} |
261 |
+ |
|
262 |
+ |
TIBDateTimeField = class(TTimeField) |
263 |
+ |
private |
264 |
+ |
FHasTimeZone: boolean; |
265 |
+ |
FTimeZoneServices: ITimeZoneServices; |
266 |
+ |
function GetTimeZoneServices: ITimeZoneServices; |
267 |
+ |
function GetDateTimeBuffer(var aBuffer: TIBBufferedDateTimeWithTimeZone): boolean; |
268 |
+ |
function GetTimeZoneID: TFBTimeZoneID; |
269 |
+ |
function GetTimeZoneName: string; |
270 |
+ |
procedure SetTimeZoneID(aValue: TFBTimeZoneID); |
271 |
+ |
procedure SetTimeZoneName(AValue: string); |
272 |
+ |
protected |
273 |
+ |
procedure Bind(Binding: Boolean); override; |
274 |
+ |
function GetAsDateTime: TDateTime; override; |
275 |
+ |
function GetAsVariant: variant; override; |
276 |
+ |
function GetDataSize: Integer; override; |
277 |
+ |
procedure GetText(var theText: string; ADisplayText: Boolean); override; |
278 |
+ |
procedure SetAsDateTime(AValue: TDateTime); override; |
279 |
+ |
procedure SetAsString(const AValue: string); override; |
280 |
+ |
procedure SetVarValue(const AValue: Variant); override; |
281 |
+ |
public |
282 |
+ |
constructor Create(AOwner: TComponent); override; |
283 |
+ |
function GetAsDateTimeTZ(var aDateTime: TDateTime; var dstOffset: smallint; |
284 |
+ |
var aTimeZoneID: TFBTimeZoneID): boolean; overload; |
285 |
+ |
function GetAsDateTimeTZ(var aDateTime: TDateTime; var dstOffset: smallint; |
286 |
+ |
var aTimeZone: string): boolean; overload; |
287 |
+ |
function GetAsUTCDateTime: TDateTime; |
288 |
+ |
procedure SetAsDateTimeTZ(aDateTime: TDateTime; aTimeZoneID: TFBTimeZoneID); overload; |
289 |
+ |
procedure SetAsDateTimeTZ(aDateTime: TDateTime; aTimeZone: string); overload; |
290 |
+ |
property TimeZoneName: string read GetTimeZoneName write SetTimeZoneName; |
291 |
+ |
property TimeZoneID: TFBTimeZoneID read GetTimeZoneID; |
292 |
+ |
published |
293 |
+ |
property HasTimeZone: boolean read FHasTimeZone; |
294 |
+ |
end; |
295 |
+ |
|
296 |
+ |
{ TIBTimeField } |
297 |
+ |
|
298 |
+ |
TIBTimeField = class(TIBDateTimeField) |
299 |
+ |
public |
300 |
+ |
constructor Create(AOwner: TComponent); override; |
301 |
+ |
end; |
302 |
+ |
|
303 |
|
{ TIBDataLink } |
304 |
|
|
305 |
|
TIBDataLink = class(TDetailDataLink) |
306 |
|
private |
307 |
|
FDataSet: TIBCustomDataSet; |
308 |
|
FDelayTimerValue: integer; |
309 |
< |
FTimer: TFPTimer; |
309 |
> |
FTimer: IIBTimerInf; |
310 |
|
procedure HandleRefreshTimer(Sender: TObject); |
311 |
+ |
procedure SetDelayTimerValue(AValue: integer); |
312 |
|
protected |
313 |
|
procedure ActiveChanged; override; |
314 |
|
procedure RecordChanged(Field: TField); override; |
318 |
|
constructor Create(ADataSet: TIBCustomDataSet); |
319 |
|
destructor Destroy; override; |
320 |
|
property DelayTimerValue: integer {in Milliseconds} |
321 |
< |
read FDelayTimerValue write FDelayTimerValue; |
321 |
> |
read FDelayTimerValue write SetDelayTimerValue; |
322 |
|
end; |
323 |
|
|
324 |
|
TIBGeneratorApplyOnEvent = (gaeOnNewRecord,gaeOnPostRecord); |
372 |
|
|
373 |
|
TIBAutoCommit = (acDisabled, acCommitRetaining); |
374 |
|
|
367 |
– |
{ TIBCustomDataSet } |
368 |
– |
|
375 |
|
TIBUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApply, uaApplied); |
376 |
|
|
377 |
|
TIBUpdateErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError; |
380 |
|
TIBUpdateRecordEvent = procedure(DataSet: TDataSet; UpdateKind: TUpdateKind; |
381 |
|
var UpdateAction: TIBUpdateAction) of object; |
382 |
|
|
377 |
– |
TIBUpdateRecordTypes = set of TCachedUpdateStatus; |
378 |
– |
|
383 |
|
TDataSetCloseAction = (dcDiscardChanges, dcSaveChanges); |
384 |
|
|
385 |
|
TOnValidatePost = procedure (Sender: TObject; var CancelPost: boolean) of object; |
386 |
|
|
387 |
|
TOnDeleteReturning = procedure (Sender: TObject; QryResults: IResults) of object; |
388 |
|
|
389 |
+ |
{ TIBCustomDataSet } |
390 |
+ |
|
391 |
|
TIBCustomDataSet = class(TDataset) |
392 |
|
private |
393 |
+ |
const |
394 |
+ |
BufferCacheSize = 1000; { Allocate cache in this many record chunks} |
395 |
+ |
UniCache = 2; { Uni-directional cache is 2 records big } |
396 |
+ |
|
397 |
+ |
{Buffer cache constants for record selection} |
398 |
+ |
FILE_BEGIN = 0; |
399 |
+ |
FILE_CURRENT = 1; |
400 |
+ |
FILE_END = 2; |
401 |
+ |
|
402 |
+ |
{internal type declarations} |
403 |
+ |
type |
404 |
+ |
TArrayDataArray = array [0..0] of TIBArray; |
405 |
+ |
PArrayDataArray = ^TArrayDataArray; |
406 |
+ |
|
407 |
+ |
TBlobDataArray = array[0..0] of TIBBlobStream; |
408 |
+ |
PBlobDataArray = ^TBlobDataArray; |
409 |
+ |
|
410 |
+ |
TCachedUpdateStatus = ( |
411 |
+ |
cusUnmodified, cusModified, cusInserted, |
412 |
+ |
cusDeleted, cusUninserted |
413 |
+ |
); |
414 |
+ |
TIBUpdateRecordTypes = set of TCachedUpdateStatus; |
415 |
+ |
|
416 |
+ |
PFieldData = ^TFieldData; |
417 |
+ |
TFieldData = record |
418 |
+ |
fdIsNull: Boolean; |
419 |
+ |
fdDataLength: Short; |
420 |
+ |
end; |
421 |
+ |
|
422 |
+ |
PColumnData = ^TColumnData; |
423 |
+ |
TColumnData = record |
424 |
+ |
fdDataType: Short; |
425 |
+ |
fdDataScale: Short; |
426 |
+ |
fdNullable: Boolean; |
427 |
+ |
fdDataSize: Short; |
428 |
+ |
fdDataOfs: Integer; |
429 |
+ |
fdCodePage: TSystemCodePage; |
430 |
+ |
end; |
431 |
+ |
|
432 |
+ |
PFieldColumns = ^TFieldColumns; |
433 |
+ |
TFieldColumns = array[1..1] of TColumnData; |
434 |
+ |
|
435 |
+ |
protected |
436 |
+ |
type |
437 |
+ |
TIBDBKey = record |
438 |
+ |
DBKey: array[0..7] of Byte; |
439 |
+ |
end; |
440 |
+ |
PIBDBKey = ^TIBDBKey; |
441 |
+ |
|
442 |
+ |
TRecordData = record |
443 |
+ |
rdBookmarkFlag: TBookmarkFlag; |
444 |
+ |
rdFieldCount: Short; |
445 |
+ |
rdRecordNumber: Integer; |
446 |
+ |
rdCachedUpdateStatus: TCachedUpdateStatus; |
447 |
+ |
rdUpdateStatus: TUpdateStatus; |
448 |
+ |
rdSavedOffset: DWORD; |
449 |
+ |
rdDBKey: TIBDBKey; |
450 |
+ |
rdFields: array[1..1] of TFieldData; |
451 |
+ |
end; |
452 |
+ |
PRecordData = ^TRecordData; |
453 |
+ |
|
454 |
+ |
private |
455 |
|
FAllowAutoActivateTransaction: Boolean; |
456 |
|
FArrayFieldCount: integer; |
457 |
|
FArrayCacheOffset: integer; |
458 |
|
FAutoCommit: TIBAutoCommit; |
459 |
+ |
FCaseSensitiveParameterNames: boolean; |
460 |
+ |
FDefaultTZDate: TDateTime; |
461 |
|
FEnableStatistics: boolean; |
462 |
|
FGenerateParamNames: Boolean; |
463 |
|
FGeneratorField: TIBGenerator; |
499 |
|
FRecordCount: Integer; |
500 |
|
FRecordSize: Integer; |
501 |
|
FDataSetCloseAction: TDataSetCloseAction; |
502 |
+ |
FTZTextOption: TTZTextOptions; |
503 |
+ |
FSQLFiltered: boolean; |
504 |
+ |
FSQLFilterParams: TStrings; |
505 |
|
FUniDirectional: Boolean; |
506 |
|
FUpdateMode: TUpdateMode; |
507 |
|
FUpdateObject: TIBDataSetUpdateObject; |
536 |
|
FieldIndex: integer; Buffer: PChar); |
537 |
|
procedure InitModelBuffer(Qry: TIBSQL; Buffer: PChar); |
538 |
|
function GetSelectStmtIntf: IStatement; |
539 |
+ |
procedure SetCaseSensitiveParameterNames(AValue: boolean); |
540 |
+ |
procedure SetDefaultTZDate(AValue: TDateTime); |
541 |
+ |
procedure SetSQLFiltered(AValue: boolean); |
542 |
+ |
procedure SetSQLFilterParams(AValue: TStrings); |
543 |
|
procedure SetUpdateMode(const Value: TUpdateMode); |
544 |
|
procedure SetUpdateObject(Value: TIBDataSetUpdateObject); |
545 |
|
|
573 |
|
function GetModifySQL: TStrings; |
574 |
|
function GetTransaction: TIBTransaction; |
575 |
|
function GetParser: TSelectSQLParser; |
576 |
+ |
procedure HandleSQLFilterParamsChanged(Sender: TObject); |
577 |
|
procedure InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer); virtual; |
578 |
|
function InternalLocate(const KeyFields: string; const KeyValues: Variant; |
579 |
|
Options: TLocateOptions): Boolean; virtual; |
658 |
|
procedure DoBeforeInsert; override; |
659 |
|
procedure DoAfterInsert; override; |
660 |
|
procedure DoBeforeClose; override; |
583 |
– |
procedure DoBeforeOpen; override; |
661 |
|
procedure DoBeforePost; override; |
662 |
|
procedure DoAfterPost; override; |
663 |
|
procedure FreeRecordBuffer(var Buffer: PChar); override; |
693 |
|
function IsCursorOpen: Boolean; override; |
694 |
|
procedure Loaded; override; |
695 |
|
procedure ReQuery; |
696 |
+ |
procedure ResetBufferCache; |
697 |
|
procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override; |
698 |
|
procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override; |
699 |
|
procedure SetCachedUpdates(Value: Boolean); |
717 |
|
property QModify: TIBSQL read FQModify; |
718 |
|
property StatementType: TIBSQLStatementTypes read GetStatementType; |
719 |
|
property SelectStmtHandle: IStatement read GetSelectStmtIntf; |
720 |
+ |
property Parser: TSelectSQLParser read GetParser; |
721 |
+ |
property BaseSQLSelect: TStrings read FBaseSQLSelect; |
722 |
|
|
723 |
|
{Likely to be made published by descendant classes} |
724 |
+ |
property CaseSensitiveParameterNames: boolean read FCaseSensitiveParameterNames |
725 |
+ |
write SetCaseSensitiveParameterNames; |
726 |
|
property BufferChunks: Integer read FBufferChunks write SetBufferChunks; |
727 |
|
property CachedUpdates: Boolean read FCachedUpdates write SetCachedUpdates; |
728 |
|
property UniDirectional: Boolean read FUniDirectional write SetUniDirectional default False; |
734 |
|
property ModifySQL: TStrings read GetModifySQL write SetModifySQL; |
735 |
|
property UpdateMode: TUpdateMode read FUpdateMode write SetUpdateMode default upWhereAll; |
736 |
|
property ParamCheck: Boolean read FParamCheck write FParamCheck default True; |
737 |
< |
property Parser: TSelectSQLParser read GetParser; |
738 |
< |
property BaseSQLSelect: TStrings read FBaseSQLSelect; |
737 |
> |
property TZTextOption: TTZTextOptions read FTZTextOption write FTZTextOption; |
738 |
> |
property SQLFiltered: boolean read FSQLFiltered write SetSQLFiltered; |
739 |
> |
property SQLFilterParams: TStrings read FSQLFilterParams write SetSQLFilterParams; |
740 |
|
|
741 |
|
property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect |
742 |
|
write FBeforeDatabaseDisconnect; |
788 |
|
function IsSequenced: Boolean; override; |
789 |
|
procedure Post; override; |
790 |
|
function ParamByName(ParamName: String): ISQLParam; |
791 |
+ |
function FindParam(ParamName: String): ISQLParam; |
792 |
|
property ArrayFieldCount: integer read FArrayFieldCount; |
793 |
|
property DatabaseInfo: TIBDatabaseInfo read FDatabaseInfo; |
794 |
|
property UpdateObject: TIBDataSetUpdateObject read FUpdateObject write SetUpdateObject; |
798 |
|
property MasterDetailDelay: integer read GetMasterDetailDelay write SetMasterDetailDelay; |
799 |
|
property DataSetCloseAction: TDataSetCloseAction |
800 |
|
read FDataSetCloseAction write FDataSetCloseAction; |
801 |
+ |
property DefaultTZDate: TDateTime read FDefaultTZDate write SetDefaultTZDate; |
802 |
|
|
803 |
|
public |
804 |
|
{Performance Statistics} |
847 |
|
write FOnDeleteReturning; |
848 |
|
end; |
849 |
|
|
850 |
+ |
{ TIBParserDataSet } |
851 |
+ |
|
852 |
|
TIBParserDataSet = class(TIBCustomDataSet) |
853 |
+ |
protected |
854 |
+ |
procedure DoBeforeOpen; override; |
855 |
|
public |
856 |
|
property Parser; |
857 |
|
end; |
888 |
|
property AutoCommit; |
889 |
|
property BufferChunks; |
890 |
|
property CachedUpdates; |
891 |
+ |
property CaseSensitiveParameterNames; |
892 |
|
property EnableStatistics; |
893 |
|
property DeleteSQL; |
894 |
|
property InsertSQL; |
902 |
|
property UniDirectional; |
903 |
|
property Filtered; |
904 |
|
property DataSetCloseAction; |
905 |
+ |
property TZTextOption; |
906 |
+ |
property DefaultTZDate; |
907 |
+ |
property SQLFiltered; |
908 |
+ |
property SQLFilterParams; |
909 |
|
|
910 |
|
property BeforeDatabaseDisconnect; |
911 |
|
property AfterDatabaseDisconnect; |
974 |
|
FCharacterSetName: RawByteString; |
975 |
|
FCharacterSetSize: integer; |
976 |
|
FCodePage: TSystemCodePage; |
977 |
+ |
FHasTimeZone: boolean; |
978 |
|
FIdentityColumn: boolean; |
979 |
|
FRelationName: string; |
980 |
|
FDataSize: integer; |
987 |
|
property ArrayDimensions: integer read FArrayDimensions write FArrayDimensions; |
988 |
|
property ArrayBounds: TArrayBounds read FArrayBounds write FArrayBounds; |
989 |
|
property IdentityColumn: boolean read FIdentityColumn write FIdentityColumn default false; |
990 |
+ |
property HasTimeZone: boolean read FHasTimeZone write FHasTimeZone default false; |
991 |
|
end; |
992 |
|
|
993 |
|
const |
994 |
< |
DefaultFieldClasses: array[TFieldType] of TFieldClass = ( |
994 |
> |
DefaultFieldClasses: array[TFieldType] of TFieldClass = ( |
995 |
|
nil, { ftUnknown } |
996 |
|
TIBStringField, { ftString } |
997 |
|
TIBSmallintField, { ftSmallint } |
998 |
< |
TIBIntegerField, { ftInteger } |
998 |
> |
TIBIntegerField, { ftInteger } |
999 |
|
TWordField, { ftWord } |
1000 |
|
TBooleanField, { ftBoolean } |
1001 |
|
TFloatField, { ftFloat } |
1002 |
|
TCurrencyField, { ftCurrency } |
1003 |
|
TIBBCDField, { ftBCD } |
1004 |
|
TDateField, { ftDate } |
1005 |
< |
TTimeField, { ftTime } |
1006 |
< |
TDateTimeField, { ftDateTime } |
1005 |
> |
TIBTimeField, { ftTime } |
1006 |
> |
TIBDateTimeField, { ftDateTime } |
1007 |
|
TBytesField, { ftBytes } |
1008 |
|
TVarBytesField, { ftVarBytes } |
1009 |
|
TAutoIncField, { ftAutoInc } |
1016 |
|
TBlobField, { ftTypedBinary } |
1017 |
|
nil, { ftCursor } |
1018 |
|
TStringField, { ftFixedChar } |
1019 |
< |
nil, { ftWideString } |
1020 |
< |
TIBLargeIntField, { ftLargeInt } |
1021 |
< |
nil, { ftADT } |
1022 |
< |
TIBArrayField, { ftArray } |
1023 |
< |
nil, { ftReference } |
1024 |
< |
nil, { ftDataSet } |
929 |
< |
TBlobField, { ftOraBlob } |
930 |
< |
TMemoField, { ftOraClob } |
931 |
< |
TVariantField, { ftVariant } |
932 |
< |
nil, { ftInterface } |
933 |
< |
nil, { ftIDispatch } |
934 |
< |
TGuidField, { ftGuid } |
935 |
< |
TDateTimeField, {ftTimestamp} |
936 |
< |
TIBBCDField, {ftFMTBcd} |
937 |
< |
nil, {ftFixedWideChar} |
938 |
< |
nil); {ftWideMemo} |
939 |
< |
(* |
940 |
< |
TADTField, { ftADT } |
941 |
< |
TArrayField, { ftArray } |
942 |
< |
TReferenceField, { ftReference } |
943 |
< |
TDataSetField, { ftDataSet } |
1019 |
> |
nil, { ftWideString } |
1020 |
> |
TIBLargeIntField, { ftLargeInt } |
1021 |
> |
nil, { ftADT } |
1022 |
> |
TIBArrayField, { ftArray } |
1023 |
> |
nil, { ftReference } |
1024 |
> |
nil, { ftDataSet } |
1025 |
|
TBlobField, { ftOraBlob } |
1026 |
|
TMemoField, { ftOraClob } |
1027 |
|
TVariantField, { ftVariant } |
1028 |
< |
TInterfaceField, { ftInterface } |
1029 |
< |
TIDispatchField, { ftIDispatch } |
1030 |
< |
TGuidField); { ftGuid } *) |
1028 |
> |
nil, { ftInterface } |
1029 |
> |
nil, { ftIDispatch } |
1030 |
> |
TGuidField, { ftGuid } |
1031 |
> |
TIBDateTimeField, { ftTimestamp } |
1032 |
> |
TFmtBCDField, { ftFMTBcd } |
1033 |
> |
nil, { ftFixedWideChar } |
1034 |
> |
nil { ftWideMemo } |
1035 |
> |
{$IF declared(ftOraTimeStamp)} |
1036 |
> |
{These six extra elements were added to the FPC fixes_3_2 branch in Q3 2021} |
1037 |
> |
, |
1038 |
> |
nil, {ftOraTimeStamp} |
1039 |
> |
nil, {ftOraInterval} |
1040 |
> |
nil, {ftLongWord} |
1041 |
> |
nil, {ftShortint} |
1042 |
> |
nil, {ftByte} |
1043 |
> |
nil {ftExtended} |
1044 |
> |
{$IFEND} |
1045 |
> |
); |
1046 |
|
(*var |
1047 |
|
CreateProviderProc: function(DataSet: TIBCustomDataSet): IProvider = nil;*) |
1048 |
|
|
1049 |
|
implementation |
1050 |
|
|
1051 |
< |
uses Variants, FmtBCD, LazUTF8, FBMessages, IBQuery; |
956 |
< |
|
957 |
< |
const FILE_BEGIN = 0; |
958 |
< |
FILE_CURRENT = 1; |
959 |
< |
FILE_END = 2; |
1051 |
> |
uses Variants, FmtBCD, LazUTF8, IBMessages, IBQuery, DateUtils, dbconst; |
1052 |
|
|
1053 |
|
type |
1054 |
|
|
1110 |
|
Result := str; |
1111 |
|
end; |
1112 |
|
|
1113 |
+ |
{ TIBDateTimeField } |
1114 |
+ |
|
1115 |
+ |
function TIBDateTimeField.GetTimeZoneName: string; |
1116 |
+ |
var aBuffer: TIBBufferedDateTimeWithTimeZone; |
1117 |
+ |
begin |
1118 |
+ |
if GetDateTimeBuffer(aBuffer) then |
1119 |
+ |
Result := GetTimeZoneServices.TimeZoneID2TimeZoneName(aBuffer.TimeZoneID) |
1120 |
+ |
else |
1121 |
+ |
Result := ''; |
1122 |
+ |
end; |
1123 |
+ |
|
1124 |
+ |
function TIBDateTimeField.GetTimeZoneServices: ITimeZoneServices; |
1125 |
+ |
begin |
1126 |
+ |
if (FTimeZoneServices = nil) and |
1127 |
+ |
(DataSet <> nil) and ((DataSet as TIBCustomDataSet).Database <> nil) |
1128 |
+ |
and ((DataSet as TIBCustomDataSet).Database.attachment <> nil) then |
1129 |
+ |
FTimeZoneServices := (DataSet as TIBCustomDataSet).Database.attachment.GetTimeZoneServices; |
1130 |
+ |
Result := FTimeZoneServices; |
1131 |
+ |
end; |
1132 |
+ |
|
1133 |
+ |
function TIBDateTimeField.GetDateTimeBuffer( |
1134 |
+ |
var aBuffer: TIBBufferedDateTimeWithTimeZone): boolean; |
1135 |
+ |
begin |
1136 |
+ |
Result := HasTimeZone; |
1137 |
+ |
if Result then |
1138 |
+ |
Result := GetData(@aBuffer,False); |
1139 |
+ |
end; |
1140 |
+ |
|
1141 |
+ |
function TIBDateTimeField.GetTimeZoneID: TFBTimeZoneID; |
1142 |
+ |
var aBuffer: TIBBufferedDateTimeWithTimeZone; |
1143 |
+ |
begin |
1144 |
+ |
if GetDateTimeBuffer(aBuffer) then |
1145 |
+ |
Result := aBuffer.TimeZoneID |
1146 |
+ |
else |
1147 |
+ |
Result := TimeZoneID_GMT; |
1148 |
+ |
end; |
1149 |
+ |
|
1150 |
+ |
procedure TIBDateTimeField.SetTimeZoneID(aValue: TFBTimeZoneID); |
1151 |
+ |
var aBuffer: TIBBufferedDateTimeWithTimeZone; |
1152 |
+ |
begin |
1153 |
+ |
if GetDateTimeBuffer(aBuffer) then |
1154 |
+ |
SetAsDateTimeTZ(aBuffer.Timestamp,aValue) |
1155 |
+ |
end; |
1156 |
+ |
|
1157 |
+ |
procedure TIBDateTimeField.SetTimeZoneName(AValue: string); |
1158 |
+ |
var aBuffer: TIBBufferedDateTimeWithTimeZone; |
1159 |
+ |
begin |
1160 |
+ |
if GetDateTimeBuffer(aBuffer) then |
1161 |
+ |
SetAsDateTimeTZ(aBuffer.Timestamp,aValue) |
1162 |
+ |
end; |
1163 |
+ |
|
1164 |
+ |
procedure TIBDateTimeField.Bind(Binding: Boolean); |
1165 |
+ |
var IBFieldDef: TIBFieldDef; |
1166 |
+ |
begin |
1167 |
+ |
inherited Bind(Binding); |
1168 |
+ |
if Binding and (FieldDef <> nil) then |
1169 |
+ |
begin |
1170 |
+ |
IBFieldDef := FieldDef as TIBFieldDef; |
1171 |
+ |
FHasTimeZone := IBFieldDef.HasTimeZone; |
1172 |
+ |
end; |
1173 |
+ |
end; |
1174 |
+ |
|
1175 |
+ |
function TIBDateTimeField.GetAsDateTime: TDateTime; |
1176 |
+ |
var aBuffer: TIBBufferedDateTimeWithTimeZone; |
1177 |
+ |
begin |
1178 |
+ |
if GetDateTimeBuffer(aBuffer) then |
1179 |
+ |
Result := aBuffer.Timestamp |
1180 |
+ |
else |
1181 |
+ |
Result := inherited GetAsDateTime; |
1182 |
+ |
end; |
1183 |
+ |
|
1184 |
+ |
function TIBDateTimeField.GetAsVariant: variant; |
1185 |
+ |
var aBuffer: TIBBufferedDateTimeWithTimeZone; |
1186 |
+ |
begin |
1187 |
+ |
if GetDateTimeBuffer(aBuffer) then |
1188 |
+ |
with aBuffer do |
1189 |
+ |
Result := VarArrayOf([Timestamp,dstOffset,TimeZoneID]) |
1190 |
+ |
else |
1191 |
+ |
Result := inherited GetAsVariant; |
1192 |
+ |
end; |
1193 |
+ |
|
1194 |
+ |
function TIBDateTimeField.GetDataSize: Integer; |
1195 |
+ |
begin |
1196 |
+ |
if HasTimeZone then |
1197 |
+ |
Result := sizeof(TIBBufferedDateTimeWithTimeZone) |
1198 |
+ |
else |
1199 |
+ |
Result := inherited GetDataSize; |
1200 |
+ |
end; |
1201 |
+ |
|
1202 |
+ |
procedure TIBDateTimeField.GetText(var theText: string; ADisplayText: Boolean); |
1203 |
+ |
var aBuffer: TIBBufferedDateTimeWithTimeZone; |
1204 |
+ |
F: string; |
1205 |
+ |
begin |
1206 |
+ |
if Dataset = nil then |
1207 |
+ |
DatabaseErrorFmt(SNoDataset,[FieldName]); |
1208 |
+ |
|
1209 |
+ |
if GetDateTimeBuffer(aBuffer) then |
1210 |
+ |
{$if declared(DefaultFormatSettings)} |
1211 |
+ |
with DefaultFormatSettings do |
1212 |
+ |
{$else} |
1213 |
+ |
{$if declared(FormatSettings)} |
1214 |
+ |
with FormatSettings do |
1215 |
+ |
{$ifend} |
1216 |
+ |
{$ifend} |
1217 |
+ |
begin |
1218 |
+ |
if ADisplayText and (Length(DisplayFormat) <> 0) then |
1219 |
+ |
F := DisplayFormat |
1220 |
+ |
else |
1221 |
+ |
Case DataType of |
1222 |
+ |
ftTime : F := LongTimeFormat; |
1223 |
+ |
ftDate : F := ShortDateFormat; |
1224 |
+ |
else |
1225 |
+ |
F := ShortDateFormat + ' ' + LongTimeFormat; |
1226 |
+ |
end; |
1227 |
+ |
|
1228 |
+ |
with aBuffer do |
1229 |
+ |
case (DataSet as TIBCustomDataSet).TZTextOption of |
1230 |
+ |
tzOffset: |
1231 |
+ |
TheText := FBFormatDateTime(F,timestamp) + ' ' + FormatTimeZoneOffset(dstOffset); |
1232 |
+ |
tzGMT: |
1233 |
+ |
TheText := FBFormatDateTime(F,IncMinute(Timestamp,-dstOffset)); |
1234 |
+ |
tzOriginalID: |
1235 |
+ |
TheText := FBFormatDateTime(F,timestamp) + ' ' + GetTimeZoneServices.TimeZoneID2TimeZoneName(TimeZoneID); |
1236 |
+ |
end; |
1237 |
+ |
end |
1238 |
+ |
else |
1239 |
+ |
inherited GetText(theText, ADisplayText); |
1240 |
+ |
end; |
1241 |
+ |
|
1242 |
+ |
procedure TIBDateTimeField.SetAsDateTime(AValue: TDateTime); |
1243 |
+ |
var aBuffer: TIBBufferedDateTimeWithTimeZone; |
1244 |
+ |
begin |
1245 |
+ |
if GetDateTimeBuffer(aBuffer) then |
1246 |
+ |
SetAsDateTimeTZ(AValue,aBuffer.TimeZoneID) |
1247 |
+ |
else |
1248 |
+ |
inherited SetAsDateTime(AValue) |
1249 |
+ |
end; |
1250 |
+ |
|
1251 |
+ |
procedure TIBDateTimeField.SetAsString(const AValue: string); |
1252 |
+ |
var aDateTime: TDateTime; |
1253 |
+ |
aTimeZone: AnsiString; |
1254 |
+ |
begin |
1255 |
+ |
if AValue = '' then |
1256 |
+ |
Clear |
1257 |
+ |
else |
1258 |
+ |
if ParseDateTimeTZString(AValue,aDateTime,aTimeZone,DataType=ftTime) then |
1259 |
+ |
begin |
1260 |
+ |
if not HasTimeZone or (aTimeZone = '') then |
1261 |
+ |
SetAsDateTime(aDateTime) |
1262 |
+ |
else |
1263 |
+ |
SetAsDateTimeTZ(aDateTime,aTimeZone); |
1264 |
+ |
end |
1265 |
+ |
else |
1266 |
+ |
IBError(ibxeBadDateTimeTZString,[AValue]); |
1267 |
+ |
end; |
1268 |
+ |
|
1269 |
+ |
procedure TIBDateTimeField.SetVarValue(const AValue: Variant); |
1270 |
+ |
begin |
1271 |
+ |
if HasTimeZone and VarIsArray(AValue)then |
1272 |
+ |
SetAsDateTimeTZ(AValue[0],string(AValue[2])) |
1273 |
+ |
else |
1274 |
+ |
inherited SetVarValue(AValue); |
1275 |
+ |
end; |
1276 |
+ |
|
1277 |
+ |
constructor TIBDateTimeField.Create(AOwner: TComponent); |
1278 |
+ |
begin |
1279 |
+ |
inherited Create(AOwner); |
1280 |
+ |
SetDataType(ftDateTime); |
1281 |
+ |
end; |
1282 |
+ |
|
1283 |
+ |
function TIBDateTimeField.GetAsDateTimeTZ(var aDateTime: TDateTime; |
1284 |
+ |
var dstOffset: smallint; var aTimeZoneID: TFBTimeZoneID): boolean; |
1285 |
+ |
var aBuffer: TIBBufferedDateTimeWithTimeZone; |
1286 |
+ |
begin |
1287 |
+ |
Result := GetDateTimeBuffer(aBuffer); |
1288 |
+ |
if Result then |
1289 |
+ |
begin |
1290 |
+ |
aDateTime := aBuffer.Timestamp; |
1291 |
+ |
dstOffset := aBuffer.dstOffset; |
1292 |
+ |
aTimeZoneID := aBuffer.TimeZoneID; |
1293 |
+ |
end |
1294 |
+ |
else |
1295 |
+ |
aDateTime := inherited GetAsDateTime |
1296 |
+ |
end; |
1297 |
+ |
|
1298 |
+ |
function TIBDateTimeField.GetAsDateTimeTZ(var aDateTime: TDateTime; |
1299 |
+ |
var dstOffset: smallint; var aTimeZone: string): boolean; |
1300 |
+ |
var aTimeZoneID: TFBTimeZoneID; |
1301 |
+ |
begin |
1302 |
+ |
Result := GetAsDateTimeTZ(aDateTime,dstOffset,aTimeZoneID); |
1303 |
+ |
if Result then |
1304 |
+ |
aTimeZone := GetTimeZoneServices.TimeZoneID2TimeZoneName(aTimeZoneID); |
1305 |
+ |
end; |
1306 |
+ |
|
1307 |
+ |
function TIBDateTimeField.GetAsUTCDateTime: TDateTime; |
1308 |
+ |
var aBuffer: TIBBufferedDateTimeWithTimeZone; |
1309 |
+ |
begin |
1310 |
+ |
if GetDateTimeBuffer(aBuffer) then |
1311 |
+ |
Result := IncMinute(aBuffer.timestamp,-aBuffer.dstOffset) |
1312 |
+ |
else |
1313 |
+ |
Result := inherited GetAsDateTime; |
1314 |
+ |
end; |
1315 |
+ |
|
1316 |
+ |
procedure TIBDateTimeField.SetAsDateTimeTZ(aDateTime: TDateTime; |
1317 |
+ |
aTimeZoneID: TFBTimeZoneID); |
1318 |
+ |
var DateTimeBuffer: TIBBufferedDateTimeWithTimeZone; |
1319 |
+ |
begin |
1320 |
+ |
if HasTimeZone then |
1321 |
+ |
begin |
1322 |
+ |
DateTimeBuffer.Timestamp := aDateTime; |
1323 |
+ |
DateTimeBuffer.dstOffset := GetTimeZoneServices.GetEffectiveOffsetMins(aDateTime,aTimeZoneID); |
1324 |
+ |
DateTimeBuffer.TimeZoneID := aTimeZoneID; |
1325 |
+ |
SetData(@DateTimeBuffer,False); |
1326 |
+ |
end |
1327 |
+ |
else |
1328 |
+ |
inherited SetAsDateTime(aDateTime); |
1329 |
+ |
end; |
1330 |
+ |
|
1331 |
+ |
procedure TIBDateTimeField.SetAsDateTimeTZ(aDateTime: TDateTime; |
1332 |
+ |
aTimeZone: string); |
1333 |
+ |
begin |
1334 |
+ |
if HasTimeZone then |
1335 |
+ |
SetAsDateTimeTZ(aDateTime,GetTimeZoneServices.TimeZoneName2TimeZoneID(aTimeZone)) |
1336 |
+ |
else |
1337 |
+ |
inherited SetAsDateTime(aDateTime); |
1338 |
+ |
end; |
1339 |
+ |
|
1340 |
+ |
{ TIBTimeField } |
1341 |
+ |
|
1342 |
+ |
constructor TIBTimeField.Create(AOwner: TComponent); |
1343 |
+ |
begin |
1344 |
+ |
inherited Create(AOwner); |
1345 |
+ |
SetDataType(ftTime); |
1346 |
+ |
end; |
1347 |
+ |
|
1348 |
+ |
{ TIBParserDataSet } |
1349 |
+ |
|
1350 |
+ |
procedure TIBParserDataSet.DoBeforeOpen; |
1351 |
+ |
var i: integer; |
1352 |
+ |
begin |
1353 |
+ |
if assigned(FParser) then |
1354 |
+ |
FParser.RestoreClauseValues; |
1355 |
+ |
if SQLFiltered then |
1356 |
+ |
for i := 0 to SQLFilterParams.Count - 1 do |
1357 |
+ |
Parser.Add2WhereClause(SQLFilterParams[i]); |
1358 |
+ |
for i := 0 to FIBLinks.Count - 1 do |
1359 |
+ |
TIBControlLink(FIBLinks[i]).UpdateSQL(self); |
1360 |
+ |
inherited DoBeforeOpen; |
1361 |
+ |
for i := 0 to FIBLinks.Count - 1 do |
1362 |
+ |
TIBControlLink(FIBLinks[i]).UpdateParams(self); |
1363 |
+ |
end; |
1364 |
+ |
|
1365 |
|
{ TIBLargeIntField } |
1366 |
|
|
1367 |
|
procedure TIBLargeIntField.Bind(Binding: Boolean); |
1500 |
|
3, {Assume UNICODE_FSS is really UTF8} |
1501 |
|
4: {Include GB18030 - assuming UTF8 routines work for this codeset} |
1502 |
|
if DisplayWidth = 0 then |
1503 |
+ |
{$if declared(Utf8EscapeControlChars)} |
1504 |
+ |
Result := Utf8EscapeControlChars(TextToSingleLine(Result)) |
1505 |
+ |
{$else} |
1506 |
|
Result := ValidUTF8String(TextToSingleLine(Result)) |
1507 |
+ |
{$endif} |
1508 |
|
else |
1509 |
|
if UTF8Length(Result) > DisplayWidth then {Show truncation with elipses} |
1510 |
+ |
{$if declared(Utf8EscapeControlChars)} |
1511 |
+ |
Result := Utf8EscapeControlChars(TextToSingleLine(UTF8Copy(Result,1,DisplayWidth-3))) + '...'; |
1512 |
+ |
{$else} |
1513 |
|
Result := ValidUTF8String(TextToSingleLine(UTF8Copy(Result,1,DisplayWidth-3))) + '...'; |
1514 |
+ |
{$endif} |
1515 |
|
end; |
1516 |
|
end |
1517 |
|
end; |
1616 |
|
IBFieldDef := FieldDef as TIBFieldDef; |
1617 |
|
CharacterSetSize := IBFieldDef.CharacterSetSize; |
1618 |
|
CharacterSetName := IBFieldDef.CharacterSetName; |
1619 |
< |
FDataSize := IBFieldDef.DataSize + 1; |
1619 |
> |
FDataSize := IBFieldDef.DataSize; |
1620 |
|
if AutoFieldSize then |
1621 |
|
Size := IBFieldDef.Size; |
1622 |
|
CodePage := IBFieldDef.CodePage; |
1659 |
|
s: RawByteString; |
1660 |
|
begin |
1661 |
|
Buffer := nil; |
1662 |
< |
IBAlloc(Buffer, 0, DataSize); |
1662 |
> |
IBAlloc(Buffer, 0, DataSize + 1); {allow for trailing #0} |
1663 |
|
try |
1664 |
|
Result := GetData(Buffer); |
1665 |
|
if Result then |
1668 |
|
SetCodePage(s,CodePage,false); |
1669 |
|
if (CodePage <> CP_NONE) and (CodePage <> CP_UTF8) then |
1670 |
|
SetCodePage(s,CP_UTF8,true); {LCL only accepts UTF8} |
1671 |
< |
Value := s; |
1671 |
> |
|
1672 |
> |
if (CodePage = CP_UTF8) and (UTF8Length(s) > Size) then |
1673 |
> |
{truncate to max. number of UTF8 characters - usually a problem with |
1674 |
> |
fixed width columns right padded with white space} |
1675 |
> |
Value := UTF8Copy(s,1,Size) |
1676 |
> |
else |
1677 |
> |
Value := s; |
1678 |
> |
|
1679 |
|
// writeln(FieldName,': ', StringCodePage(Value),', ',Value); |
1680 |
|
if Transliterate and (Value <> '') then |
1681 |
|
DataSet.Translate(PChar(Value), PChar(Value), False); |
1691 |
|
s: RawByteString; |
1692 |
|
begin |
1693 |
|
Buffer := nil; |
1694 |
< |
IBAlloc(Buffer, 0, DataSize); |
1694 |
> |
IBAlloc(Buffer, 0, DataSize + 1); {allow for trailing #0} |
1695 |
|
try |
1696 |
|
s := Value; |
1697 |
|
if StringCodePage(s) <> CodePage then |
1698 |
|
SetCodePage(s,CodePage,CodePage<>CP_NONE); |
1699 |
< |
StrLCopy(Buffer, PChar(s), DataSize-1); |
1699 |
> |
StrLCopy(Buffer, PChar(s), DataSize); |
1700 |
|
if Transliterate then |
1701 |
|
DataSet.Translate(Buffer, Buffer, True); |
1702 |
|
SetData(Buffer); |
1768 |
|
begin |
1769 |
|
inherited Create; |
1770 |
|
FDataSet := ADataSet; |
1771 |
< |
FTimer := TFPTimer.Create(nil); |
1772 |
< |
FTimer.Enabled := true; |
1773 |
< |
FTimer.Interval := 0; |
1774 |
< |
FTimer.OnTimer := HandleRefreshTimer; |
1771 |
> |
if assigned(IBGUIInterface) then |
1772 |
> |
begin |
1773 |
> |
FTimer := IBGUIInterface.CreateTimer; |
1774 |
> |
if FTimer <> nil then |
1775 |
> |
begin |
1776 |
> |
FTimer.Enabled := false; |
1777 |
> |
FTimer.Interval := 0; |
1778 |
> |
FTimer.OnTimer := HandleRefreshTimer; |
1779 |
> |
end; |
1780 |
> |
end; |
1781 |
|
FDelayTimerValue := 0; |
1782 |
|
end; |
1783 |
|
|
1784 |
|
destructor TIBDataLink.Destroy; |
1785 |
|
begin |
1786 |
|
FDataSet.FDataLink := nil; |
1422 |
– |
if assigned(FTimer) then FTimer.Free; |
1787 |
|
inherited Destroy; |
1788 |
|
end; |
1789 |
|
|
1790 |
|
procedure TIBDataLink.HandleRefreshTimer(Sender: TObject); |
1791 |
|
begin |
1792 |
< |
FTimer.Interval := 0; |
1793 |
< |
FDataSet.RefreshParams; |
1792 |
> |
FTimer.Enabled := false; |
1793 |
> |
if FDataSet.Active then |
1794 |
> |
FDataSet.RefreshParams; |
1795 |
> |
end; |
1796 |
> |
|
1797 |
> |
procedure TIBDataLink.SetDelayTimerValue(AValue: integer); |
1798 |
> |
begin |
1799 |
> |
if FDelayTimerValue = AValue then Exit; |
1800 |
> |
if assigned(FTimer) then |
1801 |
> |
FTimer.Enabled := false; |
1802 |
> |
FDelayTimerValue := AValue; |
1803 |
|
end; |
1804 |
|
|
1805 |
|
procedure TIBDataLink.ActiveChanged; |
1806 |
|
begin |
1807 |
< |
if FDataSet.Active then |
1807 |
> |
if DetailDataSet.Active and DataSet.Active then |
1808 |
|
FDataSet.RefreshParams; |
1809 |
|
end; |
1810 |
|
|
1818 |
|
begin |
1819 |
|
if (Field = nil) and FDataSet.Active then |
1820 |
|
begin |
1821 |
< |
if FDelayTimerValue > 0 then |
1821 |
> |
if assigned(FTimer) and (FDelayTimerValue > 0) then |
1822 |
> |
with FTimer do |
1823 |
|
begin |
1824 |
+ |
FTimer.Enabled := false; |
1825 |
|
FTimer.Interval := FDelayTimerValue; |
1826 |
< |
FTimer.StartTimer; |
1826 |
> |
FTimer.Enabled := true; |
1827 |
|
end |
1828 |
|
else |
1829 |
|
FDataSet.RefreshParams; |
1854 |
|
FDataLink := TIBDataLink.Create(Self); |
1855 |
|
FQDelete := TIBSQL.Create(Self); |
1856 |
|
FQDelete.OnSQLChanging := SQLChanging; |
1857 |
< |
FQDelete.GoToFirstRecordOnExecute := False; |
1857 |
> |
FQDelete.GoToFirstRecordOnExecute := True; |
1858 |
|
FQInsert := TIBSQL.Create(Self); |
1859 |
|
FQInsert.OnSQLChanging := SQLChanging; |
1860 |
< |
FQInsert.GoToFirstRecordOnExecute := False; |
1860 |
> |
FQInsert.GoToFirstRecordOnExecute := true; |
1861 |
|
FQRefresh := TIBSQL.Create(Self); |
1862 |
|
FQRefresh.OnSQLChanging := SQLChanging; |
1863 |
|
FQRefresh.GoToFirstRecordOnExecute := False; |
1867 |
|
FQSelect.GoToFirstRecordOnExecute := False; |
1868 |
|
FQModify := TIBSQL.Create(Self); |
1869 |
|
FQModify.OnSQLChanging := SQLChanging; |
1870 |
< |
FQModify.GoToFirstRecordOnExecute := False; |
1870 |
> |
FQModify.GoToFirstRecordOnExecute := True; {In Firebird 5, Update..Returning returns a cursor} |
1871 |
|
FUpdateRecordTypes := [cusUnmodified, cusModified, cusInserted]; |
1872 |
|
FParamCheck := True; |
1873 |
|
FGenerateParamNames := False; |
1888 |
|
if AOwner is TIBTransaction then |
1889 |
|
Transaction := TIBTransaction(AOwner); |
1890 |
|
FBaseSQLSelect := TStringList.Create; |
1891 |
+ |
FTZTextOption := tzOffset; |
1892 |
+ |
FDefaultTZDate := EncodeDate(2020,1,1); |
1893 |
+ |
FSQLFilterParams := TStringList.Create; |
1894 |
+ |
TStringList(FSQLFilterParams).OnChange := HandleSQLFilterParamsChanged; |
1895 |
|
end; |
1896 |
|
|
1897 |
|
destructor TIBCustomDataSet.Destroy; |
1914 |
|
FMappedFieldPosition := nil; |
1915 |
|
if assigned(FBaseSQLSelect) then FBaseSQLSelect.Free; |
1916 |
|
if assigned(FParser) then FParser.Free; |
1917 |
+ |
if assigned(FSQLFilterParams) then FSQLFilterParams.Free; |
1918 |
|
inherited Destroy; |
1919 |
|
end; |
1920 |
|
|
1999 |
|
|
2000 |
|
procedure UpdateUsingOnUpdateRecord; |
2001 |
|
begin |
1622 |
– |
UpdateAction := uaFail; |
2002 |
|
try |
2003 |
|
FOnUpdateRecord(Self, UpdateKind, UpdateAction); |
2004 |
|
except |
2005 |
|
on E: Exception do |
2006 |
|
begin |
2007 |
+ |
UpdateAction := uaFail; |
2008 |
|
if (E is EDatabaseError) and Assigned(FOnUpdateError) then |
2009 |
< |
FOnUpdateError(Self, EIBError(E), UpdateKind, UpdateAction); |
1630 |
< |
if UpdateAction = uaFail then |
1631 |
< |
raise; |
2009 |
> |
FOnUpdateError(Self, EDatabaseError(E), UpdateKind, UpdateAction); |
2010 |
|
end; |
2011 |
|
end; |
2012 |
|
end; |
2015 |
|
begin |
2016 |
|
try |
2017 |
|
FUpdateObject.Apply(UpdateKind,PChar(Buffer)); |
2018 |
< |
ResetBufferUpdateStatus; |
2018 |
> |
UpdateAction := uaApplied; |
2019 |
|
except |
2020 |
|
on E: Exception do |
2021 |
+ |
begin |
2022 |
+ |
UpdateAction := uaFail; |
2023 |
|
if (E is EDatabaseError) and Assigned(FOnUpdateError) then |
2024 |
< |
FOnUpdateError(Self, EIBError(E), UpdateKind, UpdateAction); |
2024 |
> |
FOnUpdateError(Self, EDatabaseError(E), UpdateKind, UpdateAction); |
2025 |
> |
end; |
2026 |
|
end; |
2027 |
|
end; |
2028 |
|
|
2037 |
|
cusDeleted: |
2038 |
|
InternalDeleteRecord(FQDelete, Buffer); |
2039 |
|
end; |
2040 |
+ |
UpdateAction := uaApplied; |
2041 |
|
except |
2042 |
< |
on E: EIBError do begin |
2042 |
> |
on E: Exception do begin |
2043 |
|
UpdateAction := uaFail; |
2044 |
< |
if Assigned(FOnUpdateError) then |
2045 |
< |
FOnUpdateError(Self, E, UpdateKind, UpdateAction); |
1664 |
< |
case UpdateAction of |
1665 |
< |
uaFail: raise; |
1666 |
< |
uaAbort: SysUtils.Abort; |
1667 |
< |
uaSkip: bRecordsSkipped := True; |
1668 |
< |
end; |
2044 |
> |
if (E is EDatabaseError) and Assigned(FOnUpdateError) then |
2045 |
> |
FOnUpdateError(Self, EDatabaseError(E), UpdateKind, UpdateAction); |
2046 |
|
end; |
2047 |
|
end; |
2048 |
|
end; |
2064 |
|
Buffer := PRecordData(GetActiveBuf); |
2065 |
|
GetUpdateKind; |
2066 |
|
UpdateAction := uaApply; |
2067 |
< |
if Assigned(FUpdateObject) or Assigned(FOnUpdateRecord) then |
2067 |
> |
if (Assigned(FOnUpdateRecord)) then |
2068 |
> |
UpdateUsingOnUpdateRecord; |
2069 |
> |
if UpdateAction = uaApply then |
2070 |
|
begin |
2071 |
< |
if (Assigned(FOnUpdateRecord)) then |
2072 |
< |
UpdateUsingOnUpdateRecord |
2071 |
> |
if Assigned(FUpdateObject) then |
2072 |
> |
UpdateUsingUpdateObject |
2073 |
|
else |
2074 |
< |
if Assigned(FUpdateObject) then |
1696 |
< |
UpdateUsingUpdateObject; |
1697 |
< |
case UpdateAction of |
1698 |
< |
uaFail: |
1699 |
< |
IBError(ibxeUserAbort, [nil]); |
1700 |
< |
uaAbort: |
1701 |
< |
SysUtils.Abort; |
1702 |
< |
uaApplied: |
1703 |
< |
ResetBufferUpdateStatus; |
1704 |
< |
uaSkip: |
1705 |
< |
bRecordsSkipped := True; |
1706 |
< |
uaRetry: |
1707 |
< |
Continue; |
1708 |
< |
end; |
2074 |
> |
UpdateUsingInternalquery; |
2075 |
|
end; |
2076 |
< |
if (not Assigned(FUpdateObject)) and (UpdateAction = UaApply) then |
2077 |
< |
begin |
2078 |
< |
UpdateUsingInternalquery; |
2079 |
< |
UpdateAction := uaApplied; |
2076 |
> |
|
2077 |
> |
case UpdateAction of |
2078 |
> |
uaFail: |
2079 |
> |
IBError(ibxeUserAbort, [nil]); |
2080 |
> |
uaAbort: |
2081 |
> |
SysUtils.Abort; |
2082 |
> |
uaApplied: |
2083 |
> |
ResetBufferUpdateStatus; |
2084 |
> |
uaSkip: |
2085 |
> |
bRecordsSkipped := True; |
2086 |
> |
uaRetry: |
2087 |
> |
Continue; |
2088 |
|
end; |
2089 |
+ |
|
2090 |
|
Next; |
2091 |
|
end; |
2092 |
|
FUpdatesPending := bRecordsSkipped; |
2260 |
|
Buff: PRecordData; |
2261 |
|
begin |
2262 |
|
Buff := PRecordData(GetActiveBuf); |
2263 |
< |
result := (FQModify.SQL.Text <> '') or |
2264 |
< |
(Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukModify).Text <> '')) or |
2263 |
> |
result := (Trim(FQModify.SQL.Text) <> '') or |
2264 |
> |
(Assigned(FUpdateObject) and (Trim(FUpdateObject.GetSQL(ukModify).Text) <> '')) or |
2265 |
|
((Buff <> nil) and (Buff^.rdCachedUpdateStatus = cusInserted) and |
2266 |
|
(FCachedUpdates)); |
2267 |
|
end; |
2268 |
|
|
2269 |
|
function TIBCustomDataSet.CanInsert: Boolean; |
2270 |
|
begin |
2271 |
< |
result := (FQInsert.SQL.Text <> '') or |
2272 |
< |
(Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukInsert).Text <> '')); |
2271 |
> |
result := (Trim(FQInsert.SQL.Text) <> '') or |
2272 |
> |
(Assigned(FUpdateObject) and (Trim(FUpdateObject.GetSQL(ukInsert).Text) <> '')); |
2273 |
|
end; |
2274 |
|
|
2275 |
|
function TIBCustomDataSet.CanDelete: Boolean; |
2276 |
|
begin |
2277 |
< |
if (FQDelete.SQL.Text <> '') or |
2278 |
< |
(Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukDelete).Text <> '')) then |
2277 |
> |
if (Trim(FQDelete.SQL.Text) <> '') or |
2278 |
> |
(Assigned(FUpdateObject) and (Trim(FUpdateObject.GetSQL(ukDelete).Text) <> '')) then |
2279 |
|
result := True |
2280 |
|
else |
2281 |
|
result := False; |
2283 |
|
|
2284 |
|
function TIBCustomDataSet.CanRefresh: Boolean; |
2285 |
|
begin |
2286 |
< |
result := (FQRefresh.SQL.Text <> '') or |
2287 |
< |
(Assigned(FUpdateObject) and (FUpdateObject.RefreshSQL.Text <> '')); |
2286 |
> |
result := (Trim(FQRefresh.SQL.Text) <> '') or |
2287 |
> |
(Assigned(FUpdateObject) and (Trim(FUpdateObject.RefreshSQL.Text) <> '')); |
2288 |
|
end; |
2289 |
|
|
2290 |
|
procedure TIBCustomDataSet.CheckEditState; |
2451 |
|
SQL_TYPE_DATE, |
2452 |
|
SQL_TYPE_TIME: |
2453 |
|
fdDataSize := SizeOf(TDateTime); |
2454 |
+ |
SQL_TIMESTAMP_TZ, |
2455 |
+ |
SQL_TIMESTAMP_TZ_EX, |
2456 |
+ |
SQL_TIME_TZ, |
2457 |
+ |
SQL_TIME_TZ_EX: |
2458 |
+ |
fdDataSize := SizeOf(TIBBufferedDateTimeWithTimeZone); |
2459 |
|
SQL_SHORT, SQL_LONG: |
2460 |
|
begin |
2461 |
|
if (fdDataScale = 0) then |
2483 |
|
SQL_VARYING, |
2484 |
|
SQL_TEXT, |
2485 |
|
SQL_BLOB: |
2486 |
< |
fdCodePage := Qry.Metadata[i].getCodePage; |
2486 |
> |
fdCodePage := colMetadata.getCodePage; |
2487 |
> |
SQL_DEC16, |
2488 |
> |
SQL_DEC34, |
2489 |
> |
SQL_DEC_FIXED, |
2490 |
> |
SQL_INT128: |
2491 |
> |
fdDataSize := sizeof(tBCD); |
2492 |
|
end; |
2493 |
|
fdDataOfs := FRecordSize; |
2494 |
|
Inc(FRecordSize, fdDataSize); |
2502 |
|
procedure TIBCustomDataSet.UpdateRecordFromQuery(QryResults: IResults; |
2503 |
|
Buffer: PChar); |
2504 |
|
var i, j: integer; |
2505 |
+ |
pda: PArrayDataArray; |
2506 |
+ |
pbd: PBlobDataArray; |
2507 |
|
begin |
2508 |
+ |
{ Make sure blob cache is empty } |
2509 |
+ |
pbd := PBlobDataArray(Buffer + FBlobCacheOffset); |
2510 |
+ |
pda := PArrayDataArray(Buffer + FArrayCacheOffset); |
2511 |
+ |
for i := 0 to BlobFieldCount - 1 do |
2512 |
+ |
pbd^[i] := nil; |
2513 |
+ |
for i := 0 to ArrayFieldCount - 1 do |
2514 |
+ |
pda^[i] := nil; |
2515 |
+ |
|
2516 |
|
for i := 0 to QryResults.Count - 1 do |
2517 |
|
begin |
2518 |
|
j := GetFieldPosition(QryResults[i].GetAliasName); |
2531 |
|
ColumnIndex, FieldIndex: integer; Buffer: PChar); |
2532 |
|
var |
2533 |
|
LocalData: PByte; |
2534 |
< |
LocalDate: TDateTime; |
2140 |
< |
LocalDouble: Double; |
2141 |
< |
LocalInt: Integer; |
2142 |
< |
LocalBool: wordBool; |
2143 |
< |
LocalInt64: Int64; |
2144 |
< |
LocalCurrency: Currency; |
2534 |
> |
BufPtr: PByte; |
2535 |
|
ColData: ISQLData; |
2536 |
|
begin |
2537 |
|
LocalData := nil; |
2538 |
|
with PRecordData(Buffer)^.rdFields[FieldIndex], FFieldColumns^[FieldIndex] do |
2539 |
|
begin |
2540 |
|
QryResults.GetData(ColumnIndex,fdIsNull,fdDataLength,LocalData); |
2541 |
+ |
BufPtr := PByte(Buffer + fdDataOfs); |
2542 |
|
if not fdIsNull then |
2543 |
|
begin |
2544 |
|
ColData := QryResults[ColumnIndex]; |
2546 |
|
SQL_TYPE_DATE, |
2547 |
|
SQL_TYPE_TIME, |
2548 |
|
SQL_TIMESTAMP: |
2158 |
– |
begin |
2549 |
|
{This is an IBX native format and not the TDataset approach. See also GetFieldData} |
2550 |
< |
LocalDate := ColData.AsDateTime; |
2551 |
< |
LocalData := PByte(@LocalDate); |
2550 |
> |
PDateTime(BufPtr)^ := ColData.AsDateTime; |
2551 |
> |
|
2552 |
> |
SQL_TIMESTAMP_TZ, |
2553 |
> |
SQL_TIMESTAMP_TZ_EX: |
2554 |
> |
begin |
2555 |
> |
with PIBBufferedDateTimeWithTimeZone(Bufptr)^ do |
2556 |
> |
ColData.GetAsDateTime(Timestamp,dstOffset,TimeZoneID); |
2557 |
> |
end; |
2558 |
> |
|
2559 |
> |
SQL_TIME_TZ, |
2560 |
> |
SQL_TIME_TZ_EX: |
2561 |
> |
begin |
2562 |
> |
with PIBBufferedDateTimeWithTimeZone(Bufptr)^ do |
2563 |
> |
ColData.GetAsTime(Timestamp, dstOffset,TimeZoneID, DefaultTZDate); |
2564 |
|
end; |
2565 |
|
SQL_SHORT, SQL_LONG: |
2566 |
|
begin |
2567 |
|
if (fdDataScale = 0) then |
2568 |
< |
begin |
2167 |
< |
LocalInt := ColData.AsLong; |
2168 |
< |
LocalData := PByte(@LocalInt); |
2169 |
< |
end |
2568 |
> |
PInteger(BufPtr)^ := ColData.AsLong |
2569 |
|
else |
2570 |
|
if (fdDataScale >= (-4)) then |
2571 |
< |
begin |
2173 |
< |
LocalCurrency := ColData.AsCurrency; |
2174 |
< |
LocalData := PByte(@LocalCurrency); |
2175 |
< |
end |
2571 |
> |
PCurrency(BufPtr)^ := ColData.AsCurrency |
2572 |
|
else |
2573 |
< |
begin |
2178 |
< |
LocalDouble := ColData.AsDouble; |
2179 |
< |
LocalData := PByte(@LocalDouble); |
2180 |
< |
end; |
2573 |
> |
PDouble(BufPtr)^ := ColData.AsDouble; |
2574 |
|
end; |
2575 |
|
SQL_INT64: |
2576 |
|
begin |
2577 |
|
if (fdDataScale = 0) then |
2578 |
< |
begin |
2186 |
< |
LocalInt64 := ColData.AsInt64; |
2187 |
< |
LocalData := PByte(@LocalInt64); |
2188 |
< |
end |
2578 |
> |
PInt64(BufPtr)^ := ColData.AsInt64 |
2579 |
|
else |
2580 |
|
if (fdDataScale >= (-4)) then |
2581 |
< |
begin |
2582 |
< |
LocalCurrency := ColData.AsCurrency; |
2583 |
< |
LocalData := PByte(@LocalCurrency); |
2194 |
< |
end |
2195 |
< |
else |
2196 |
< |
begin |
2197 |
< |
LocalDouble := ColData.AsDouble; |
2198 |
< |
LocalData := PByte(@LocalDouble); |
2199 |
< |
end |
2581 |
> |
PCurrency(BufPtr)^ := ColData.AsCurrency |
2582 |
> |
else |
2583 |
> |
PDouble(BufPtr)^ := ColData.AsDouble; |
2584 |
|
end; |
2585 |
+ |
|
2586 |
|
SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT: |
2587 |
< |
begin |
2588 |
< |
LocalDouble := ColData.AsDouble; |
2204 |
< |
LocalData := PByte(@LocalDouble); |
2205 |
< |
end; |
2587 |
> |
PDouble(BufPtr)^ := ColData.AsDouble; |
2588 |
> |
|
2589 |
|
SQL_BOOLEAN: |
2590 |
< |
begin |
2591 |
< |
LocalBool := ColData.AsBoolean; |
2592 |
< |
LocalData := PByte(@LocalBool); |
2593 |
< |
end; |
2594 |
< |
end; |
2590 |
> |
system.PBoolean(BufPtr)^ := ColData.AsBoolean; |
2591 |
> |
|
2592 |
> |
SQL_DEC16, |
2593 |
> |
SQL_DEC34, |
2594 |
> |
SQL_DEC_FIXED, |
2595 |
> |
SQL_INT128: |
2596 |
> |
pBCD(BufPtr)^ := ColData.GetAsBCD; |
2597 |
|
|
2213 |
– |
if fdDataType = SQL_VARYING then |
2214 |
– |
Move(LocalData^, Buffer[fdDataOfs], fdDataLength) |
2598 |
|
else |
2599 |
< |
Move(LocalData^, Buffer[fdDataOfs], fdDataSize) |
2599 |
> |
begin |
2600 |
> |
if fdDataType = SQL_VARYING then |
2601 |
> |
Move(LocalData^, BufPtr^, fdDataLength) |
2602 |
> |
else |
2603 |
> |
Move(LocalData^, BufPtr^, fdDataSize) |
2604 |
> |
end; |
2605 |
> |
end; {case} |
2606 |
|
end |
2607 |
|
else {Null column} |
2608 |
|
if fdDataType = SQL_VARYING then |
2609 |
< |
FillChar(Buffer[fdDataOfs],fdDataLength,0) |
2609 |
> |
FillChar(BufPtr^,fdDataLength,0) |
2610 |
|
else |
2611 |
< |
FillChar(Buffer[fdDataOfs],fdDataSize,0); |
2611 |
> |
FillChar(BufPtr^,fdDataSize,0); |
2612 |
|
end; |
2613 |
|
end; |
2614 |
|
|
2950 |
|
begin |
2951 |
|
if Buff <> nil then |
2952 |
|
begin |
2953 |
< |
if (Assigned(FUpdateObject) and (FUpdateObject.RefreshSQL.Text <> '')) then |
2953 |
> |
if (Assigned(FUpdateObject) and (Trim(FUpdateObject.RefreshSQL.Text) <> '')) then |
2954 |
|
begin |
2955 |
|
Qry := TIBSQL.Create(self); |
2956 |
|
Qry.Database := Database; |
3065 |
|
ActivateTransaction; |
3066 |
|
FBase.CheckDatabase; |
3067 |
|
FBase.CheckTransaction; |
3068 |
< |
if HasParser and (FParser.SQLText <> FQSelect.SQL.Text) then |
3068 |
> |
if HasParser and not FParser.NotaSelectStmt and (FParser.SQLText <> FQSelect.SQL.Text) then |
3069 |
|
begin |
3070 |
|
FQSelect.OnSQLChanged := nil; {Do not react to change} |
3071 |
|
try |
3204 |
|
|
3205 |
|
procedure TIBCustomDataSet.SetInternalSQLParams(Params: ISQLParams; Buffer: Pointer); |
3206 |
|
var |
3207 |
< |
i, j: Integer; |
3208 |
< |
cr, data: PChar; |
3207 |
> |
i, j, arr: Integer; |
3208 |
> |
cr, data: PByte; |
3209 |
|
fn: string; |
3210 |
|
st: RawByteString; |
3211 |
|
OldBuffer: Pointer; |
3212 |
|
Param: ISQLParam; |
3213 |
+ |
pda: PArrayDataArray; |
3214 |
|
begin |
3215 |
|
if (Buffer = nil) then |
3216 |
|
IBError(ibxeBufferNotSet, [nil]); |
3218 |
|
InternalPrepare; |
3219 |
|
OldBuffer := nil; |
3220 |
|
try |
3221 |
+ |
pda := PArrayDataArray(PChar(Buffer) + FArrayCacheOffset); |
3222 |
+ |
arr := 0; |
3223 |
|
for i := 0 to Params.GetCount - 1 do |
3224 |
|
begin |
3225 |
|
Param := Params[i]; |
3258 |
|
case fdDataType of |
3259 |
|
SQL_TEXT, SQL_VARYING: |
3260 |
|
begin |
3261 |
< |
SetString(st, data, fdDataLength); |
3261 |
> |
SetString(st, PAnsiChar(data), fdDataLength); |
3262 |
|
SetCodePage(st,fdCodePage,false); |
3263 |
|
Param.AsString := st; |
3264 |
|
end; |
3284 |
|
else |
3285 |
|
Param.AsDouble := PDouble(data)^; |
3286 |
|
end; |
3287 |
< |
SQL_BLOB, SQL_ARRAY, SQL_QUAD: |
3287 |
> |
SQL_BLOB, SQL_QUAD: |
3288 |
|
Param.AsQuad := PISC_QUAD(data)^; |
3289 |
+ |
SQL_ARRAY: |
3290 |
+ |
begin |
3291 |
+ |
if pda[arr] = nil then |
3292 |
+ |
Param.AsQuad := PISC_QUAD(data)^ |
3293 |
+ |
else |
3294 |
+ |
Param.AsArray := pda[arr].ArrayIntf; |
3295 |
+ |
Inc(arr); |
3296 |
+ |
end; |
3297 |
|
SQL_TYPE_DATE, |
3298 |
|
SQL_TYPE_TIME, |
3299 |
|
SQL_TIMESTAMP: |
3300 |
|
{This is an IBX native format and not the TDataset approach. See also SetFieldData} |
3301 |
|
Param.AsDateTime := PDateTime(data)^; |
3302 |
+ |
SQL_TIMESTAMP_TZ_EX, |
3303 |
+ |
SQL_TIMESTAMP_TZ: |
3304 |
+ |
with PIBBufferedDateTimeWithTimeZone(data)^ do |
3305 |
+ |
Param.SetAsDateTime(Timestamp,TimeZoneID); |
3306 |
+ |
SQL_TIME_TZ_EX, |
3307 |
+ |
SQL_TIME_TZ: |
3308 |
+ |
with PIBBufferedDateTimeWithTimeZone(data)^ do |
3309 |
+ |
Param.SetAsTime(Timestamp,DefaultTZDate,TimeZoneID); |
3310 |
|
SQL_BOOLEAN: |
3311 |
|
Param.AsBoolean := PWordBool(data)^; |
3312 |
+ |
SQL_DEC16, |
3313 |
+ |
SQL_DEC34, |
3314 |
+ |
SQL_DEC_FIXED, |
3315 |
+ |
SQL_INT128: |
3316 |
+ |
Param.AsBCD := pBCD(data)^; |
3317 |
+ |
else |
3318 |
+ |
IBError(ibxeUnknownSQLType,[fdDataType]); |
3319 |
|
end; |
3320 |
|
end; |
3321 |
|
end; |
3372 |
|
begin |
3373 |
|
CheckDatasetClosed; |
3374 |
|
FUniDirectional := Value; |
3375 |
+ |
inherited SetUniDirectional(Value); |
3376 |
|
end; |
3377 |
|
|
3378 |
|
procedure TIBCustomDataSet.SetUpdateRecordTypes(Value: TIBUpdateRecordTypes); |
3482 |
|
|
3483 |
|
function TIBCustomDataSet.ParamByName(ParamName: String): ISQLParam; |
3484 |
|
begin |
3485 |
+ |
Result := FindParam(ParamName); |
3486 |
+ |
if Result = nil then |
3487 |
+ |
IBError(ibxeParameterNameNotFound,[ParamName]); |
3488 |
+ |
end; |
3489 |
+ |
|
3490 |
+ |
function TIBCustomDataSet.FindParam(ParamName: String): ISQLParam; |
3491 |
+ |
begin |
3492 |
|
ActivateConnection; |
3493 |
|
ActivateTransaction; |
3494 |
|
if not FInternalPrepared then |
3571 |
|
procedure TIBCustomDataSet.ReadRecordCache(RecordNumber: Integer; Buffer: PChar; |
3572 |
|
ReadOldBuffer: Boolean); |
3573 |
|
begin |
3574 |
+ |
if RecordNumber = -1 then |
3575 |
+ |
Exit; {nothing to do} |
3576 |
|
if FUniDirectional then |
3577 |
|
RecordNumber := RecordNumber mod UniCache; |
3578 |
|
if (ReadOldBuffer) then |
3738 |
|
procedure TIBCustomDataSet.SetArrayIntf(AnArray: IArray; Field: TIBArrayField); |
3739 |
|
var Buff: PChar; |
3740 |
|
pda: PArrayDataArray; |
3741 |
+ |
MappedFieldPos: integer; |
3742 |
|
begin |
3743 |
|
if (Field = nil) or (Field.DataSet <> self) then |
3744 |
|
IBError(ibxFieldNotinDataSet,[Field.Name,Name]); |
3745 |
|
Buff := GetActiveBuf; |
3746 |
|
if Buff <> nil then |
3747 |
+ |
with PRecordData(Buff)^ do |
3748 |
|
begin |
3749 |
|
AdjustRecordOnInsert(Buff); |
3750 |
< |
pda := PArrayDataArray(Buff + FArrayCacheOffset); |
3751 |
< |
pda^[Field.FCacheOffset].FArray := AnArray; |
3752 |
< |
WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Pointer(Buff)); |
3750 |
> |
MappedFieldPos := FMappedFieldPosition[Field.FieldNo - 1]; |
3751 |
> |
if (MappedFieldPos > 0) and |
3752 |
> |
(MappedFieldPos <= rdFieldCount) then |
3753 |
> |
begin |
3754 |
> |
rdFields[MappedFieldPos].fdIsNull := AnArray = nil; |
3755 |
> |
pda := PArrayDataArray(Buff + FArrayCacheOffset); |
3756 |
> |
if pda^[Field.FCacheOffset] = nil then |
3757 |
> |
begin |
3758 |
> |
if not rdFields[MappedFieldPos].fdIsNull then |
3759 |
> |
begin |
3760 |
> |
pda^[Field.FCacheOffset] := TIBArray.Create(Field,AnArray); |
3761 |
> |
FArrayList.Add(pda^[Field.FCacheOffset]); |
3762 |
> |
end |
3763 |
> |
end |
3764 |
> |
else |
3765 |
> |
pda^[Field.FCacheOffset].FArray := AnArray; |
3766 |
> |
WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Pointer(Buff)); |
3767 |
> |
end; |
3768 |
|
end; |
3769 |
|
end; |
3770 |
|
|
3861 |
|
ApplyUpdates; |
3862 |
|
end; |
3863 |
|
|
3422 |
– |
procedure TIBCustomDataSet.DoBeforeOpen; |
3423 |
– |
var i: integer; |
3424 |
– |
begin |
3425 |
– |
if assigned(FParser) then |
3426 |
– |
FParser.Reset; |
3427 |
– |
for i := 0 to FIBLinks.Count - 1 do |
3428 |
– |
TIBControlLink(FIBLinks[i]).UpdateSQL(self); |
3429 |
– |
inherited DoBeforeOpen; |
3430 |
– |
for i := 0 to FIBLinks.Count - 1 do |
3431 |
– |
TIBControlLink(FIBLinks[i]).UpdateParams(self); |
3432 |
– |
end; |
3433 |
– |
|
3864 |
|
procedure TIBCustomDataSet.DoBeforePost; |
3865 |
|
begin |
3866 |
|
inherited DoBeforePost; |
3971 |
|
|
3972 |
|
function TIBCustomDataSet.InternalGetFieldData(Field: TField; Buffer: Pointer): Boolean; |
3973 |
|
var |
3974 |
< |
Buff, Data: PChar; |
3974 |
> |
Buff: PChar; |
3975 |
> |
Data: PByte; |
3976 |
|
CurrentRecord: PRecordData; |
3977 |
|
begin |
3978 |
|
result := False; |
3999 |
|
result := not fdIsNull; |
4000 |
|
if result and (Buffer <> nil) then |
4001 |
|
begin |
4002 |
< |
Data := Buff + fdDataOfs; |
4002 |
> |
Data := PByte(Buff) + fdDataOfs; |
4003 |
|
if (fdDataType = SQL_VARYING) or (fdDataType = SQL_TEXT) then |
4004 |
|
begin |
4005 |
< |
if fdDataLength < Field.DataSize then |
4005 |
> |
if fdDataLength <= Field.DataSize then |
4006 |
|
begin |
4007 |
|
Move(Data^, Buffer^, fdDataLength); |
4008 |
|
PChar(Buffer)[fdDataLength] := #0; |
4011 |
|
IBError(ibxeFieldSizeError,[Field.FieldName]) |
4012 |
|
end |
4013 |
|
else |
4014 |
< |
Move(Data^, Buffer^, Field.DataSize); |
4014 |
> |
if fdDataLength <= Field.DataSize then |
4015 |
> |
Move(Data^, Buffer^, Field.DataSize) |
4016 |
> |
else |
4017 |
> |
IBError(ibxeFieldSizeError,[Field.FieldName,Field.DataSize,fdDataLength]) |
4018 |
|
end; |
4019 |
|
end; |
4020 |
|
end; |
4185 |
|
Buff: PChar; |
4186 |
|
CurRec: Integer; |
4187 |
|
pda: PArrayDataArray; |
4188 |
+ |
pbd: PBlobDataArray; |
4189 |
|
i: integer; |
4190 |
|
begin |
4191 |
|
inherited InternalCancel; |
4193 |
|
if Buff <> nil then |
4194 |
|
begin |
4195 |
|
pda := PArrayDataArray(Buff + FArrayCacheOffset); |
4196 |
+ |
pbd := PBlobDataArray(Buff + FBlobCacheOffset); |
4197 |
|
for i := 0 to ArrayFieldCount - 1 do |
4198 |
|
pda^[i].ArrayIntf.CancelChanges; |
4199 |
|
CurRec := FCurrentRecord; |
4200 |
|
AdjustRecordOnInsert(Buff); |
4201 |
|
if (State = dsEdit) then begin |
4202 |
|
CopyRecordBuffer(FOldBuffer, Buff); |
4203 |
+ |
for i := 0 to BlobFieldCount - 1 do |
4204 |
+ |
pbd^[i] := nil; |
4205 |
|
WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff); |
4206 |
|
end else begin |
4207 |
|
CopyRecordBuffer(FModelBuffer, Buff); |
4219 |
|
if FDidActivate then |
4220 |
|
DeactivateTransaction; |
4221 |
|
FQSelect.Close; |
4222 |
< |
ClearBlobCache; |
3785 |
< |
ClearArrayCache; |
4222 |
> |
ResetBufferCache; |
4223 |
|
FreeRecordBuffer(FModelBuffer); |
4224 |
|
FreeRecordBuffer(FOldBuffer); |
4225 |
|
FCurrentRecord := -1; |
4226 |
|
FOpen := False; |
3790 |
– |
FRecordCount := 0; |
3791 |
– |
FDeletedRecords := 0; |
4227 |
|
FRecordSize := 0; |
3793 |
– |
FBPos := 0; |
3794 |
– |
FOBPos := 0; |
3795 |
– |
FCacheSize := 0; |
3796 |
– |
FOldCacheSize := 0; |
3797 |
– |
FBEnd := 0; |
3798 |
– |
FOBEnd := 0; |
3799 |
– |
FreeMem(FBufferCache); |
3800 |
– |
FBufferCache := nil; |
4228 |
|
FreeMem(FFieldColumns); |
4229 |
|
FFieldColumns := nil; |
3803 |
– |
FreeMem(FOldBufferCache); |
3804 |
– |
FOldBufferCache := nil; |
4230 |
|
BindFields(False); |
4231 |
|
ResetParser; |
4232 |
|
if DefaultFields then DestroyFields; |
4268 |
|
procedure TIBCustomDataSet.InternalFirst; |
4269 |
|
begin |
4270 |
|
FCurrentRecord := -1; |
4271 |
+ |
if Unidirectional then GetNextRecord; |
4272 |
|
end; |
4273 |
|
|
4274 |
|
procedure TIBCustomDataSet.InternalGotoBookmark(Bookmark: Pointer); |
4294 |
|
procedure TIBCustomDataSet.FieldDefsFromQuery(SourceQuery: TIBSQL); |
4295 |
|
const |
4296 |
|
DefaultSQL = 'Select F.RDB$COMPUTED_BLR, ' + {do not localize} |
4297 |
< |
'F.RDB$DEFAULT_VALUE, R.RDB$FIELD_NAME ' + {do not localize} |
4297 |
> |
'F.RDB$DEFAULT_VALUE, R.RDB$FIELD_NAME ' + {do not localize} |
4298 |
|
'from RDB$RELATION_FIELDS R, RDB$FIELDS F ' + {do not localize} |
4299 |
|
'where R.RDB$RELATION_NAME = :RELATION ' + {do not localize} |
4300 |
|
'and R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME '+ {do not localize} |
4327 |
|
aArrayDimensions: integer; |
4328 |
|
aArrayBounds: TArrayBounds; |
4329 |
|
ArrayMetaData: IArrayMetaData; |
4330 |
+ |
FieldHasTimeZone: boolean; |
4331 |
|
|
4332 |
|
function Add_Node(Relation, Field : String) : TRelationNode; |
4333 |
|
var |
4347 |
|
while not Query.Eof do |
4348 |
|
begin |
4349 |
|
FField := TFieldNode.Create; |
4350 |
< |
FField.FieldName := Query.Fields[2].AsString; |
4350 |
> |
FField.FieldName := TrimRight(Query.Fields[2].AsString); |
4351 |
|
FField.DEFAULT_VALUE := not Query.Fields[1].IsNull; |
4352 |
|
FField.COMPUTED_BLR := not Query.Fields[0].IsNull; |
4353 |
|
FField.IDENTITY_COLUMN := (Query.FieldCount > 3) and not Query.Fields[3].IsNull; |
4480 |
|
FieldDataSize := GetSize; |
4481 |
|
FieldPrecision := 0; |
4482 |
|
FieldNullable := IsNullable; |
4483 |
+ |
FieldHasTimeZone := false; |
4484 |
|
CharSetSize := 0; |
4485 |
|
CharSetName := ''; |
4486 |
|
FieldCodePage := CP_NONE; |
4529 |
|
FieldType := ftFloat |
4530 |
|
else |
4531 |
|
begin |
4532 |
< |
FieldType := ftFMTBCD; |
4532 |
> |
FieldType := ftBCD; |
4533 |
|
FieldPrecision := 9; |
4534 |
|
FieldSize := -getScale; |
4535 |
|
end; |
4551 |
|
SQL_TIMESTAMP: FieldType := ftDateTime; |
4552 |
|
SQL_TYPE_TIME: FieldType := ftTime; |
4553 |
|
SQL_TYPE_DATE: FieldType := ftDate; |
4554 |
+ |
SQL_TIMESTAMP_TZ, |
4555 |
+ |
SQL_TIMESTAMP_TZ_EX: |
4556 |
+ |
begin |
4557 |
+ |
FieldType := ftDateTime; |
4558 |
+ |
FieldHasTimeZone := true; |
4559 |
+ |
end; |
4560 |
+ |
SQL_TIME_TZ, |
4561 |
+ |
SQL_TIME_TZ_EX: |
4562 |
+ |
begin |
4563 |
+ |
FieldType := ftTime; |
4564 |
+ |
FieldHasTimeZone := true; |
4565 |
+ |
end; |
4566 |
|
SQL_BLOB: |
4567 |
|
begin |
4568 |
|
FieldSize := sizeof (TISC_QUAD); |
4590 |
|
end; |
4591 |
|
SQL_BOOLEAN: |
4592 |
|
FieldType:= ftBoolean; |
4593 |
+ |
|
4594 |
+ |
SQL_DEC16: |
4595 |
+ |
begin |
4596 |
+ |
FieldType := ftFmtBCD; |
4597 |
+ |
FieldPrecision := 16; |
4598 |
+ |
FieldSize := 4; {For conversions from currency type} |
4599 |
+ |
end; |
4600 |
+ |
|
4601 |
+ |
SQL_DEC34: |
4602 |
+ |
begin |
4603 |
+ |
FieldType := ftFmtBCD; |
4604 |
+ |
FieldPrecision := 34; |
4605 |
+ |
FieldSize := 4; {For conversions from currency type} |
4606 |
+ |
end; |
4607 |
+ |
|
4608 |
+ |
SQL_DEC_FIXED, |
4609 |
+ |
SQL_INT128: |
4610 |
+ |
begin |
4611 |
+ |
FieldType := ftFmtBCD; |
4612 |
+ |
FieldPrecision := 38; |
4613 |
+ |
FieldSize := -getScale; {For conversions from currency type} |
4614 |
+ |
end; |
4615 |
+ |
|
4616 |
|
else |
4617 |
|
FieldType := ftUnknown; |
4618 |
|
end; |
4636 |
|
CodePage := FieldCodePage; |
4637 |
|
ArrayDimensions := aArrayDimensions; |
4638 |
|
ArrayBounds := aArrayBounds; |
4639 |
+ |
HasTimezone := FieldHasTimeZone; |
4640 |
|
if (FieldName <> '') and (RelationName <> '') then |
4641 |
|
begin |
4642 |
|
IdentityColumn := Is_IDENTITY_COLUMN(RelationName, FieldName); |
4735 |
|
ftDate: |
4736 |
|
cur_param.AsDate := cur_field.AsDateTime; |
4737 |
|
ftTime: |
4738 |
< |
cur_param.AsTime := cur_field.AsDateTime; |
4738 |
> |
if (cur_field is TIBDateTimeField) and TIBDateTimeField(cur_field).HasTimeZone |
4739 |
> |
and (cur_param.GetSQLType = SQL_TIME_TZ) then |
4740 |
> |
cur_param.SetAsTime(cur_Field.asDateTime,DefaultTZDate,TIBDateTimeField(cur_field).TimeZoneID) |
4741 |
> |
else |
4742 |
> |
cur_param.AsTime := cur_field.AsDateTime; |
4743 |
|
ftDateTime: |
4744 |
< |
cur_param.AsDateTime := cur_field.AsDateTime; |
4744 |
> |
begin |
4745 |
> |
if (cur_field is TIBDateTimeField) and TIBDateTimeField(cur_field).HasTimeZone |
4746 |
> |
and (cur_param.GetSQLType = SQL_TIMESTAMP_TZ) then |
4747 |
> |
cur_param.SetAsDateTime(cur_field.AsDateTime,TIBDateTimeField(cur_field).TimeZoneID) |
4748 |
> |
else |
4749 |
> |
cur_param.AsDateTime := cur_field.AsDateTime; |
4750 |
> |
end; |
4751 |
|
ftBlob, ftMemo: |
4752 |
|
begin |
4753 |
|
s := nil; |
4761 |
|
end; |
4762 |
|
ftArray: |
4763 |
|
cur_param.AsArray := TIBArrayField(cur_field).ArrayIntf; |
4764 |
+ |
ftFmtBCD: |
4765 |
+ |
cur_param.AsBCD := TFmtBCDField(cur_field).AsBCD; |
4766 |
|
else |
4767 |
|
IBError(ibxeNotSupported, [nil]); |
4768 |
|
end; |
4788 |
|
First; |
4789 |
|
end; |
4790 |
|
|
4791 |
+ |
procedure TIBCustomDataSet.ResetBufferCache; |
4792 |
+ |
begin |
4793 |
+ |
ClearBlobCache; |
4794 |
+ |
ClearArrayCache; |
4795 |
+ |
FRecordCount := 0; |
4796 |
+ |
FDeletedRecords := 0; |
4797 |
+ |
FBPos := 0; |
4798 |
+ |
FOBPos := 0; |
4799 |
+ |
FCacheSize := 0; |
4800 |
+ |
FOldCacheSize := 0; |
4801 |
+ |
FBEnd := 0; |
4802 |
+ |
FOBEnd := 0; |
4803 |
+ |
FreeMem(FBufferCache); |
4804 |
+ |
FBufferCache := nil; |
4805 |
+ |
FreeMem(FOldBufferCache); |
4806 |
+ |
FOldBufferCache := nil; |
4807 |
+ |
end; |
4808 |
+ |
|
4809 |
|
procedure TIBCustomDataSet.InternalOpen; |
4810 |
|
|
4811 |
|
function RecordDataLength(n: Integer): Long; |
5013 |
|
|
5014 |
|
procedure TIBCustomDataSet.SetBookmarkData(Buffer: PChar; Data: Pointer); |
5015 |
|
begin |
5016 |
< |
PRecordData(Buffer)^.rdRecordNumber := PInteger(Data)^; |
5016 |
> |
if Data <> nil then |
5017 |
> |
PRecordData(Buffer)^.rdRecordNumber := PInteger(Data)^; |
5018 |
|
end; |
5019 |
|
|
5020 |
|
procedure TIBCustomDataSet.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); |
5070 |
|
fdIsNull := True |
5071 |
|
else |
5072 |
|
begin |
5073 |
< |
Move(Buffer^, Buff[fdDataOfs],fdDataSize); |
5073 |
> |
if fdDataSize >= Field.DataSize then |
5074 |
> |
Move(Buffer^, Buff[fdDataOfs],fdDataSize) |
5075 |
> |
else |
5076 |
> |
IBError(ibxeDBBufferTooSmall,[fdDataSize,Field.FieldName,Field.DataSize]); |
5077 |
> |
|
5078 |
|
if (fdDataType = SQL_TEXT) or (fdDataType = SQL_VARYING) then |
5079 |
|
fdDataLength := StrLen(PChar(Buffer)); |
5080 |
|
fdIsNull := False; |
5218 |
|
Result := FQSelect.Statement; |
5219 |
|
end; |
5220 |
|
|
5221 |
+ |
procedure TIBCustomDataSet.SetCaseSensitiveParameterNames(AValue: boolean); |
5222 |
+ |
begin |
5223 |
+ |
if FCaseSensitiveParameterNames = AValue then Exit; |
5224 |
+ |
FCaseSensitiveParameterNames := AValue; |
5225 |
+ |
if assigned(FQSelect) then |
5226 |
+ |
FQSelect.CaseSensitiveParameterNames := AValue; |
5227 |
+ |
end; |
5228 |
+ |
|
5229 |
+ |
procedure TIBCustomDataSet.SetDefaultTZDate(AValue: TDateTime); |
5230 |
+ |
begin |
5231 |
+ |
FDefaultTZDate := DateOf(AValue); |
5232 |
+ |
end; |
5233 |
+ |
|
5234 |
+ |
procedure TIBCustomDataSet.SetSQLFiltered(AValue: boolean); |
5235 |
+ |
begin |
5236 |
+ |
if FSQLFiltered = AValue then Exit; |
5237 |
+ |
FSQLFiltered := AValue; |
5238 |
+ |
if Active then |
5239 |
+ |
begin |
5240 |
+ |
Active := false; |
5241 |
+ |
Active := true; |
5242 |
+ |
end; |
5243 |
+ |
end; |
5244 |
+ |
|
5245 |
+ |
procedure TIBCustomDataSet.SetSQLFilterParams(AValue: TStrings); |
5246 |
+ |
begin |
5247 |
+ |
if FSQLFilterParams = AValue then Exit; |
5248 |
+ |
FSQLFilterParams.Assign(AValue); |
5249 |
+ |
end; |
5250 |
+ |
|
5251 |
|
procedure TIBCustomDataSet.SetMasterDetailDelay(AValue: integer); |
5252 |
|
begin |
5253 |
|
FDataLink.DelayTimerValue := AValue; |
5260 |
|
Result := FParser |
5261 |
|
end; |
5262 |
|
|
5263 |
+ |
procedure TIBCustomDataSet.HandleSQLFilterParamsChanged(Sender: TObject); |
5264 |
+ |
begin |
5265 |
+ |
Active := false; |
5266 |
+ |
end; |
5267 |
+ |
|
5268 |
|
procedure TIBCustomDataSet.ResetParser; |
5269 |
|
begin |
5270 |
|
if assigned(FParser) then |
5609 |
|
function TIBDataSetUpdateObject.GetRowsAffected( |
5610 |
|
var SelectCount, InsertCount, UpdateCount, DeleteCount: integer): boolean; |
5611 |
|
begin |
5612 |
+ |
Result := true; |
5613 |
|
SelectCount := 0; |
5614 |
|
InsertCount := 0; |
5615 |
|
UpdateCount := 0; |
5719 |
|
|
5720 |
|
procedure TIBGenerator.SetQuerySQL; |
5721 |
|
begin |
5722 |
< |
FQuery.SQL.Text := Format('Select Gen_ID(%s,%d) From RDB$Database',[FGeneratorName,Increment]); |
5722 |
> |
if (Database <> nil) and (FGeneratorName <> '') then |
5723 |
> |
FQuery.SQL.Text := Format('Select Gen_ID(%s,%d) From RDB$Database', |
5724 |
> |
[QuoteIdentifierIfNeeded(Database.SQLDialect,FGeneratorName),Increment]); |
5725 |
|
end; |
5726 |
|
|
5727 |
|
function TIBGenerator.GetDatabase: TIBDatabase; |
5737 |
|
procedure TIBGenerator.SetDatabase(AValue: TIBDatabase); |
5738 |
|
begin |
5739 |
|
FQuery.Database := AValue; |
5740 |
+ |
SetQuerySQL; |
5741 |
|
end; |
5742 |
|
|
5743 |
|
procedure TIBGenerator.SetGeneratorName(AValue: string); |
5782 |
|
Owner.FieldByName(FFieldName).AsInteger := GetNextValue; |
5783 |
|
end; |
5784 |
|
|
5785 |
+ |
initialization |
5786 |
+ |
RegisterClasses([TIBArrayField,TIBStringField,TIBBCDField, |
5787 |
+ |
TIBSmallintField,TIBIntegerField,TIBLargeIntField, |
5788 |
+ |
TIBMemoField, TIBDateTimeField, TIBTimeField]); |
5789 |
+ |
|
5790 |
|
|
5791 |
|
end. |