53 |
|
{$IFDEF UNIX} |
54 |
|
unix, |
55 |
|
{$ENDIF} |
56 |
< |
SysUtils, Classes, IBDatabase, IBExternals, IB, IBSQL, Db, |
57 |
< |
IBUtils, IBBlob, IBSQLParser, IBDatabaseInfo, IBTypes; |
56 |
> |
SysUtils, Classes, IBDatabase, IBExternals, IBInternals, IB, IBSQL, Db, |
57 |
> |
IBUtils, IBBlob, IBSQLParser, IBDatabaseInfo; |
58 |
|
|
59 |
|
type |
60 |
|
TIBCustomDataSet = 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 |
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: TIBTimerInf; |
309 |
> |
FTimer: IIBTimerInf; |
310 |
|
procedure HandleRefreshTimer(Sender: TObject); |
311 |
|
procedure SetDelayTimerValue(AValue: integer); |
312 |
|
protected |
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; |
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); |
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 |
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; |
675 |
< |
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 |
|
|
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} |
902 |
|
property UniDirectional; |
903 |
|
property Filtered; |
904 |
|
property DataSetCloseAction; |
905 |
+ |
property TZTextOption; |
906 |
+ |
property DefaultTZDate; |
907 |
|
property SQLFiltered; |
908 |
|
property SQLFilterParams; |
909 |
|
|
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 |
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 } |
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 |
< |
nil, { ftInterface } |
1029 |
< |
nil, { ftIDispatch } |
1030 |
< |
TGuidField, { ftGuid } |
1031 |
< |
TDateTimeField, {ftTimestamp} |
1032 |
< |
TIBBCDField, {ftFMTBcd} |
1033 |
< |
nil, {ftFixedWideChar} |
1034 |
< |
nil); {ftWideMemo} |
1035 |
< |
(* |
1036 |
< |
TADTField, { ftADT } |
1037 |
< |
TArrayField, { ftArray } |
1038 |
< |
TReferenceField, { ftReference } |
1039 |
< |
TDataSetField, { ftDataSet } |
1040 |
< |
TBlobField, { ftOraBlob } |
1041 |
< |
TMemoField, { ftOraClob } |
1042 |
< |
TVariantField, { ftVariant } |
1043 |
< |
TInterfaceField, { ftInterface } |
1044 |
< |
TIDispatchField, { ftIDispatch } |
1045 |
< |
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, IBMessages, IBQuery; |
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; |
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; |
1999 |
|
|
2000 |
|
procedure UpdateUsingOnUpdateRecord; |
2001 |
|
begin |
1698 |
– |
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); |
1706 |
< |
if UpdateAction = uaFail then |
1707 |
< |
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); |
1740 |
< |
case UpdateAction of |
1741 |
< |
uaFail: raise; |
1742 |
< |
uaAbort: SysUtils.Abort; |
1743 |
< |
uaSkip: bRecordsSkipped := True; |
1744 |
< |
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 |
1772 |
< |
UpdateUsingUpdateObject; |
1773 |
< |
case UpdateAction of |
1774 |
< |
uaFail: |
1775 |
< |
IBError(ibxeUserAbort, [nil]); |
1776 |
< |
uaAbort: |
1777 |
< |
SysUtils.Abort; |
1778 |
< |
uaApplied: |
1779 |
< |
ResetBufferUpdateStatus; |
1780 |
< |
uaSkip: |
1781 |
< |
bRecordsSkipped := True; |
1782 |
< |
uaRetry: |
1783 |
< |
Continue; |
1784 |
< |
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); |
2521 |
|
ColumnIndex, FieldIndex: integer; Buffer: PChar); |
2522 |
|
var |
2523 |
|
LocalData: PByte; |
2524 |
< |
LocalDate: TDateTime; |
2216 |
< |
LocalDouble: Double; |
2217 |
< |
LocalInt: Integer; |
2218 |
< |
LocalBool: wordBool; |
2219 |
< |
LocalInt64: Int64; |
2220 |
< |
LocalCurrency: Currency; |
2524 |
> |
BufPtr: PByte; |
2525 |
|
ColData: ISQLData; |
2526 |
|
begin |
2527 |
|
LocalData := nil; |
2528 |
|
with PRecordData(Buffer)^.rdFields[FieldIndex], FFieldColumns^[FieldIndex] do |
2529 |
|
begin |
2530 |
|
QryResults.GetData(ColumnIndex,fdIsNull,fdDataLength,LocalData); |
2531 |
+ |
BufPtr := PByte(Buffer + fdDataOfs); |
2532 |
|
if not fdIsNull then |
2533 |
|
begin |
2534 |
|
ColData := QryResults[ColumnIndex]; |
2536 |
|
SQL_TYPE_DATE, |
2537 |
|
SQL_TYPE_TIME, |
2538 |
|
SQL_TIMESTAMP: |
2234 |
– |
begin |
2539 |
|
{This is an IBX native format and not the TDataset approach. See also GetFieldData} |
2540 |
< |
LocalDate := ColData.AsDateTime; |
2541 |
< |
LocalData := PByte(@LocalDate); |
2540 |
> |
PDateTime(BufPtr)^ := ColData.AsDateTime; |
2541 |
> |
|
2542 |
> |
SQL_TIMESTAMP_TZ, |
2543 |
> |
SQL_TIMESTAMP_TZ_EX: |
2544 |
> |
begin |
2545 |
> |
with PIBBufferedDateTimeWithTimeZone(Bufptr)^ do |
2546 |
> |
ColData.GetAsDateTime(Timestamp,dstOffset,TimeZoneID); |
2547 |
> |
end; |
2548 |
> |
|
2549 |
> |
SQL_TIME_TZ, |
2550 |
> |
SQL_TIME_TZ_EX: |
2551 |
> |
begin |
2552 |
> |
with PIBBufferedDateTimeWithTimeZone(Bufptr)^ do |
2553 |
> |
ColData.GetAsTime(Timestamp, dstOffset,TimeZoneID, DefaultTZDate); |
2554 |
|
end; |
2555 |
|
SQL_SHORT, SQL_LONG: |
2556 |
|
begin |
2557 |
|
if (fdDataScale = 0) then |
2558 |
< |
begin |
2243 |
< |
LocalInt := ColData.AsLong; |
2244 |
< |
LocalData := PByte(@LocalInt); |
2245 |
< |
end |
2558 |
> |
PInteger(BufPtr)^ := ColData.AsLong |
2559 |
|
else |
2560 |
|
if (fdDataScale >= (-4)) then |
2561 |
< |
begin |
2249 |
< |
LocalCurrency := ColData.AsCurrency; |
2250 |
< |
LocalData := PByte(@LocalCurrency); |
2251 |
< |
end |
2561 |
> |
PCurrency(BufPtr)^ := ColData.AsCurrency |
2562 |
|
else |
2563 |
< |
begin |
2254 |
< |
LocalDouble := ColData.AsDouble; |
2255 |
< |
LocalData := PByte(@LocalDouble); |
2256 |
< |
end; |
2563 |
> |
PDouble(BufPtr)^ := ColData.AsDouble; |
2564 |
|
end; |
2565 |
|
SQL_INT64: |
2566 |
|
begin |
2567 |
|
if (fdDataScale = 0) then |
2568 |
< |
begin |
2262 |
< |
LocalInt64 := ColData.AsInt64; |
2263 |
< |
LocalData := PByte(@LocalInt64); |
2264 |
< |
end |
2568 |
> |
PInt64(BufPtr)^ := ColData.AsInt64 |
2569 |
|
else |
2570 |
|
if (fdDataScale >= (-4)) then |
2571 |
< |
begin |
2572 |
< |
LocalCurrency := ColData.AsCurrency; |
2573 |
< |
LocalData := PByte(@LocalCurrency); |
2270 |
< |
end |
2271 |
< |
else |
2272 |
< |
begin |
2273 |
< |
LocalDouble := ColData.AsDouble; |
2274 |
< |
LocalData := PByte(@LocalDouble); |
2275 |
< |
end |
2571 |
> |
PCurrency(BufPtr)^ := ColData.AsCurrency |
2572 |
> |
else |
2573 |
> |
PDouble(BufPtr)^ := ColData.AsDouble; |
2574 |
|
end; |
2575 |
+ |
|
2576 |
|
SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT: |
2577 |
< |
begin |
2578 |
< |
LocalDouble := ColData.AsDouble; |
2280 |
< |
LocalData := PByte(@LocalDouble); |
2281 |
< |
end; |
2577 |
> |
PDouble(BufPtr)^ := ColData.AsDouble; |
2578 |
> |
|
2579 |
|
SQL_BOOLEAN: |
2580 |
< |
begin |
2581 |
< |
LocalBool := ColData.AsBoolean; |
2582 |
< |
LocalData := PByte(@LocalBool); |
2583 |
< |
end; |
2584 |
< |
end; |
2580 |
> |
system.PBoolean(BufPtr)^ := ColData.AsBoolean; |
2581 |
> |
|
2582 |
> |
SQL_DEC16, |
2583 |
> |
SQL_DEC34, |
2584 |
> |
SQL_DEC_FIXED, |
2585 |
> |
SQL_INT128: |
2586 |
> |
pBCD(BufPtr)^ := ColData.GetAsBCD; |
2587 |
|
|
2289 |
– |
if fdDataType = SQL_VARYING then |
2290 |
– |
Move(LocalData^, Buffer[fdDataOfs], fdDataLength) |
2588 |
|
else |
2589 |
< |
Move(LocalData^, Buffer[fdDataOfs], fdDataSize) |
2589 |
> |
begin |
2590 |
> |
if fdDataType = SQL_VARYING then |
2591 |
> |
Move(LocalData^, BufPtr^, fdDataLength) |
2592 |
> |
else |
2593 |
> |
Move(LocalData^, BufPtr^, fdDataSize) |
2594 |
> |
end; |
2595 |
> |
end; {case} |
2596 |
|
end |
2597 |
|
else {Null column} |
2598 |
|
if fdDataType = SQL_VARYING then |
2599 |
< |
FillChar(Buffer[fdDataOfs],fdDataLength,0) |
2599 |
> |
FillChar(BufPtr^,fdDataLength,0) |
2600 |
|
else |
2601 |
< |
FillChar(Buffer[fdDataOfs],fdDataSize,0); |
2601 |
> |
FillChar(BufPtr^,fdDataSize,0); |
2602 |
|
end; |
2603 |
|
end; |
2604 |
|
|
2940 |
|
begin |
2941 |
|
if Buff <> nil then |
2942 |
|
begin |
2943 |
< |
if (Assigned(FUpdateObject) and (FUpdateObject.RefreshSQL.Text <> '')) then |
2943 |
> |
if (Assigned(FUpdateObject) and (Trim(FUpdateObject.RefreshSQL.Text) <> '')) then |
2944 |
|
begin |
2945 |
|
Qry := TIBSQL.Create(self); |
2946 |
|
Qry.Database := Database; |
3195 |
|
procedure TIBCustomDataSet.SetInternalSQLParams(Params: ISQLParams; Buffer: Pointer); |
3196 |
|
var |
3197 |
|
i, j: Integer; |
3198 |
< |
cr, data: PChar; |
3198 |
> |
cr, data: PByte; |
3199 |
|
fn: string; |
3200 |
|
st: RawByteString; |
3201 |
|
OldBuffer: Pointer; |
3245 |
|
case fdDataType of |
3246 |
|
SQL_TEXT, SQL_VARYING: |
3247 |
|
begin |
3248 |
< |
SetString(st, data, fdDataLength); |
3248 |
> |
SetString(st, PAnsiChar(data), fdDataLength); |
3249 |
|
SetCodePage(st,fdCodePage,false); |
3250 |
|
Param.AsString := st; |
3251 |
|
end; |
3278 |
|
SQL_TIMESTAMP: |
3279 |
|
{This is an IBX native format and not the TDataset approach. See also SetFieldData} |
3280 |
|
Param.AsDateTime := PDateTime(data)^; |
3281 |
+ |
SQL_TIMESTAMP_TZ_EX, |
3282 |
+ |
SQL_TIMESTAMP_TZ: |
3283 |
+ |
with PIBBufferedDateTimeWithTimeZone(data)^ do |
3284 |
+ |
Param.SetAsDateTime(Timestamp,TimeZoneID); |
3285 |
+ |
SQL_TIME_TZ_EX, |
3286 |
+ |
SQL_TIME_TZ: |
3287 |
+ |
with PIBBufferedDateTimeWithTimeZone(data)^ do |
3288 |
+ |
Param.SetAsTime(Timestamp,DefaultTZDate,TimeZoneID); |
3289 |
|
SQL_BOOLEAN: |
3290 |
|
Param.AsBoolean := PWordBool(data)^; |
3291 |
+ |
SQL_DEC16, |
3292 |
+ |
SQL_DEC34, |
3293 |
+ |
SQL_DEC_FIXED, |
3294 |
+ |
SQL_INT128: |
3295 |
+ |
Param.AsBCD := pBCD(data)^; |
3296 |
+ |
else |
3297 |
+ |
IBError(ibxeUnknownSQLType,[fdDataType]); |
3298 |
|
end; |
3299 |
|
end; |
3300 |
|
end; |
3550 |
|
procedure TIBCustomDataSet.ReadRecordCache(RecordNumber: Integer; Buffer: PChar; |
3551 |
|
ReadOldBuffer: Boolean); |
3552 |
|
begin |
3553 |
+ |
if RecordNumber = -1 then |
3554 |
+ |
Exit; {nothing to do} |
3555 |
|
if FUniDirectional then |
3556 |
|
RecordNumber := RecordNumber mod UniCache; |
3557 |
|
if (ReadOldBuffer) then |
3717 |
|
procedure TIBCustomDataSet.SetArrayIntf(AnArray: IArray; Field: TIBArrayField); |
3718 |
|
var Buff: PChar; |
3719 |
|
pda: PArrayDataArray; |
3720 |
+ |
MappedFieldPos: integer; |
3721 |
|
begin |
3722 |
|
if (Field = nil) or (Field.DataSet <> self) then |
3723 |
|
IBError(ibxFieldNotinDataSet,[Field.Name,Name]); |
3724 |
|
Buff := GetActiveBuf; |
3725 |
|
if Buff <> nil then |
3726 |
+ |
with PRecordData(Buff)^ do |
3727 |
|
begin |
3728 |
|
AdjustRecordOnInsert(Buff); |
3729 |
< |
pda := PArrayDataArray(Buff + FArrayCacheOffset); |
3730 |
< |
pda^[Field.FCacheOffset].FArray := AnArray; |
3731 |
< |
WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Pointer(Buff)); |
3729 |
> |
MappedFieldPos := FMappedFieldPosition[Field.FieldNo - 1]; |
3730 |
> |
if (MappedFieldPos > 0) and |
3731 |
> |
(MappedFieldPos <= rdFieldCount) then |
3732 |
> |
begin |
3733 |
> |
rdFields[MappedFieldPos].fdIsNull := AnArray = nil; |
3734 |
> |
pda := PArrayDataArray(Buff + FArrayCacheOffset); |
3735 |
> |
if pda^[Field.FCacheOffset] = nil then |
3736 |
> |
begin |
3737 |
> |
if not rdFields[MappedFieldPos].fdIsNull then |
3738 |
> |
begin |
3739 |
> |
pda^[Field.FCacheOffset] := TIBArray.Create(Field,AnArray); |
3740 |
> |
FArrayList.Add(pda^[Field.FCacheOffset]); |
3741 |
> |
end |
3742 |
> |
end |
3743 |
> |
else |
3744 |
> |
pda^[Field.FCacheOffset].FArray := AnArray; |
3745 |
> |
WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Pointer(Buff)); |
3746 |
> |
end; |
3747 |
|
end; |
3748 |
|
end; |
3749 |
|
|
3950 |
|
|
3951 |
|
function TIBCustomDataSet.InternalGetFieldData(Field: TField; Buffer: Pointer): Boolean; |
3952 |
|
var |
3953 |
< |
Buff, Data: PChar; |
3953 |
> |
Buff: PChar; |
3954 |
> |
Data: PByte; |
3955 |
|
CurrentRecord: PRecordData; |
3956 |
|
begin |
3957 |
|
result := False; |
3978 |
|
result := not fdIsNull; |
3979 |
|
if result and (Buffer <> nil) then |
3980 |
|
begin |
3981 |
< |
Data := Buff + fdDataOfs; |
3981 |
> |
Data := PByte(Buff) + fdDataOfs; |
3982 |
|
if (fdDataType = SQL_VARYING) or (fdDataType = SQL_TEXT) then |
3983 |
|
begin |
3984 |
|
if fdDataLength <= Field.DataSize then |
4198 |
|
if FDidActivate then |
4199 |
|
DeactivateTransaction; |
4200 |
|
FQSelect.Close; |
4201 |
< |
ClearBlobCache; |
3864 |
< |
ClearArrayCache; |
4201 |
> |
ResetBufferCache; |
4202 |
|
FreeRecordBuffer(FModelBuffer); |
4203 |
|
FreeRecordBuffer(FOldBuffer); |
4204 |
|
FCurrentRecord := -1; |
4205 |
|
FOpen := False; |
3869 |
– |
FRecordCount := 0; |
3870 |
– |
FDeletedRecords := 0; |
4206 |
|
FRecordSize := 0; |
3872 |
– |
FBPos := 0; |
3873 |
– |
FOBPos := 0; |
3874 |
– |
FCacheSize := 0; |
3875 |
– |
FOldCacheSize := 0; |
3876 |
– |
FBEnd := 0; |
3877 |
– |
FOBEnd := 0; |
3878 |
– |
FreeMem(FBufferCache); |
3879 |
– |
FBufferCache := nil; |
4207 |
|
FreeMem(FFieldColumns); |
4208 |
|
FFieldColumns := nil; |
3882 |
– |
FreeMem(FOldBufferCache); |
3883 |
– |
FOldBufferCache := nil; |
4209 |
|
BindFields(False); |
4210 |
|
ResetParser; |
4211 |
|
if DefaultFields then DestroyFields; |
4273 |
|
procedure TIBCustomDataSet.FieldDefsFromQuery(SourceQuery: TIBSQL); |
4274 |
|
const |
4275 |
|
DefaultSQL = 'Select F.RDB$COMPUTED_BLR, ' + {do not localize} |
4276 |
< |
'F.RDB$DEFAULT_VALUE, Trim(R.RDB$FIELD_NAME) as RDB$FIELD_NAME ' + {do not localize} |
4276 |
> |
'F.RDB$DEFAULT_VALUE, R.RDB$FIELD_NAME ' + {do not localize} |
4277 |
|
'from RDB$RELATION_FIELDS R, RDB$FIELDS F ' + {do not localize} |
4278 |
|
'where R.RDB$RELATION_NAME = :RELATION ' + {do not localize} |
4279 |
|
'and R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME '+ {do not localize} |
4281 |
|
' (not F.RDB$DEFAULT_VALUE is NULL)) '; {do not localize} |
4282 |
|
|
4283 |
|
DefaultSQLODS12 = 'Select F.RDB$COMPUTED_BLR, ' + {do not localize} |
4284 |
< |
'F.RDB$DEFAULT_VALUE, Trim(R.RDB$FIELD_NAME) as RDB$FIELD_NAME, R.RDB$IDENTITY_TYPE ' + {do not localize} |
4284 |
> |
'F.RDB$DEFAULT_VALUE, R.RDB$FIELD_NAME, R.RDB$IDENTITY_TYPE ' + {do not localize} |
4285 |
|
'from RDB$RELATION_FIELDS R, RDB$FIELDS F ' + {do not localize} |
4286 |
|
'where R.RDB$RELATION_NAME = :RELATION ' + {do not localize} |
4287 |
|
'and R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME '+ {do not localize} |
4306 |
|
aArrayDimensions: integer; |
4307 |
|
aArrayBounds: TArrayBounds; |
4308 |
|
ArrayMetaData: IArrayMetaData; |
4309 |
+ |
FieldHasTimeZone: boolean; |
4310 |
|
|
4311 |
|
function Add_Node(Relation, Field : String) : TRelationNode; |
4312 |
|
var |
4326 |
|
while not Query.Eof do |
4327 |
|
begin |
4328 |
|
FField := TFieldNode.Create; |
4329 |
< |
FField.FieldName := Query.Fields[2].AsString; |
4329 |
> |
FField.FieldName := TrimRight(Query.Fields[2].AsString); |
4330 |
|
FField.DEFAULT_VALUE := not Query.Fields[1].IsNull; |
4331 |
|
FField.COMPUTED_BLR := not Query.Fields[0].IsNull; |
4332 |
|
FField.IDENTITY_COLUMN := (Query.FieldCount > 3) and not Query.Fields[3].IsNull; |
4459 |
|
FieldDataSize := GetSize; |
4460 |
|
FieldPrecision := 0; |
4461 |
|
FieldNullable := IsNullable; |
4462 |
+ |
FieldHasTimeZone := false; |
4463 |
|
CharSetSize := 0; |
4464 |
|
CharSetName := ''; |
4465 |
|
FieldCodePage := CP_NONE; |
4508 |
|
FieldType := ftFloat |
4509 |
|
else |
4510 |
|
begin |
4511 |
< |
FieldType := ftFMTBCD; |
4511 |
> |
FieldType := ftBCD; |
4512 |
|
FieldPrecision := 9; |
4513 |
|
FieldSize := -getScale; |
4514 |
|
end; |
4530 |
|
SQL_TIMESTAMP: FieldType := ftDateTime; |
4531 |
|
SQL_TYPE_TIME: FieldType := ftTime; |
4532 |
|
SQL_TYPE_DATE: FieldType := ftDate; |
4533 |
+ |
SQL_TIMESTAMP_TZ, |
4534 |
+ |
SQL_TIMESTAMP_TZ_EX: |
4535 |
+ |
begin |
4536 |
+ |
FieldType := ftDateTime; |
4537 |
+ |
FieldHasTimeZone := true; |
4538 |
+ |
end; |
4539 |
+ |
SQL_TIME_TZ, |
4540 |
+ |
SQL_TIME_TZ_EX: |
4541 |
+ |
begin |
4542 |
+ |
FieldType := ftTime; |
4543 |
+ |
FieldHasTimeZone := true; |
4544 |
+ |
end; |
4545 |
|
SQL_BLOB: |
4546 |
|
begin |
4547 |
|
FieldSize := sizeof (TISC_QUAD); |
4569 |
|
end; |
4570 |
|
SQL_BOOLEAN: |
4571 |
|
FieldType:= ftBoolean; |
4572 |
+ |
|
4573 |
+ |
SQL_DEC16: |
4574 |
+ |
begin |
4575 |
+ |
FieldType := ftFmtBCD; |
4576 |
+ |
FieldPrecision := 16; |
4577 |
+ |
FieldSize := 4; {For conversions from currency type} |
4578 |
+ |
end; |
4579 |
+ |
|
4580 |
+ |
SQL_DEC34: |
4581 |
+ |
begin |
4582 |
+ |
FieldType := ftFmtBCD; |
4583 |
+ |
FieldPrecision := 34; |
4584 |
+ |
FieldSize := 4; {For conversions from currency type} |
4585 |
+ |
end; |
4586 |
+ |
|
4587 |
+ |
SQL_DEC_FIXED, |
4588 |
+ |
SQL_INT128: |
4589 |
+ |
begin |
4590 |
+ |
FieldType := ftFmtBCD; |
4591 |
+ |
FieldPrecision := 38; |
4592 |
+ |
FieldSize := -getScale; {For conversions from currency type} |
4593 |
+ |
end; |
4594 |
+ |
|
4595 |
|
else |
4596 |
|
FieldType := ftUnknown; |
4597 |
|
end; |
4615 |
|
CodePage := FieldCodePage; |
4616 |
|
ArrayDimensions := aArrayDimensions; |
4617 |
|
ArrayBounds := aArrayBounds; |
4618 |
+ |
HasTimezone := FieldHasTimeZone; |
4619 |
|
if (FieldName <> '') and (RelationName <> '') then |
4620 |
|
begin |
4621 |
|
IdentityColumn := Is_IDENTITY_COLUMN(RelationName, FieldName); |
4714 |
|
ftDate: |
4715 |
|
cur_param.AsDate := cur_field.AsDateTime; |
4716 |
|
ftTime: |
4717 |
< |
cur_param.AsTime := cur_field.AsDateTime; |
4717 |
> |
if (cur_field is TIBDateTimeField) and TIBDateTimeField(cur_field).HasTimeZone |
4718 |
> |
and (cur_param.GetSQLType = SQL_TIME_TZ) then |
4719 |
> |
cur_param.SetAsTime(cur_Field.asDateTime,DefaultTZDate,TIBDateTimeField(cur_field).TimeZoneID) |
4720 |
> |
else |
4721 |
> |
cur_param.AsTime := cur_field.AsDateTime; |
4722 |
|
ftDateTime: |
4723 |
< |
cur_param.AsDateTime := cur_field.AsDateTime; |
4723 |
> |
begin |
4724 |
> |
if (cur_field is TIBDateTimeField) and TIBDateTimeField(cur_field).HasTimeZone |
4725 |
> |
and (cur_param.GetSQLType = SQL_TIMESTAMP_TZ) then |
4726 |
> |
cur_param.SetAsDateTime(cur_field.AsDateTime,TIBDateTimeField(cur_field).TimeZoneID) |
4727 |
> |
else |
4728 |
> |
cur_param.AsDateTime := cur_field.AsDateTime; |
4729 |
> |
end; |
4730 |
|
ftBlob, ftMemo: |
4731 |
|
begin |
4732 |
|
s := nil; |
4740 |
|
end; |
4741 |
|
ftArray: |
4742 |
|
cur_param.AsArray := TIBArrayField(cur_field).ArrayIntf; |
4743 |
+ |
ftFmtBCD: |
4744 |
+ |
cur_param.AsBCD := TFmtBCDField(cur_field).AsBCD; |
4745 |
|
else |
4746 |
|
IBError(ibxeNotSupported, [nil]); |
4747 |
|
end; |
4767 |
|
First; |
4768 |
|
end; |
4769 |
|
|
4770 |
+ |
procedure TIBCustomDataSet.ResetBufferCache; |
4771 |
+ |
begin |
4772 |
+ |
ClearBlobCache; |
4773 |
+ |
ClearArrayCache; |
4774 |
+ |
FRecordCount := 0; |
4775 |
+ |
FDeletedRecords := 0; |
4776 |
+ |
FBPos := 0; |
4777 |
+ |
FOBPos := 0; |
4778 |
+ |
FCacheSize := 0; |
4779 |
+ |
FOldCacheSize := 0; |
4780 |
+ |
FBEnd := 0; |
4781 |
+ |
FOBEnd := 0; |
4782 |
+ |
FreeMem(FBufferCache); |
4783 |
+ |
FBufferCache := nil; |
4784 |
+ |
FreeMem(FOldBufferCache); |
4785 |
+ |
FOldBufferCache := nil; |
4786 |
+ |
end; |
4787 |
+ |
|
4788 |
|
procedure TIBCustomDataSet.InternalOpen; |
4789 |
|
|
4790 |
|
function RecordDataLength(n: Integer): Long; |
4992 |
|
|
4993 |
|
procedure TIBCustomDataSet.SetBookmarkData(Buffer: PChar; Data: Pointer); |
4994 |
|
begin |
4995 |
< |
PRecordData(Buffer)^.rdRecordNumber := PInteger(Data)^; |
4995 |
> |
if Data <> nil then |
4996 |
> |
PRecordData(Buffer)^.rdRecordNumber := PInteger(Data)^; |
4997 |
|
end; |
4998 |
|
|
4999 |
|
procedure TIBCustomDataSet.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); |
5205 |
|
FQSelect.CaseSensitiveParameterNames := AValue; |
5206 |
|
end; |
5207 |
|
|
5208 |
+ |
procedure TIBCustomDataSet.SetDefaultTZDate(AValue: TDateTime); |
5209 |
+ |
begin |
5210 |
+ |
FDefaultTZDate := DateOf(AValue); |
5211 |
+ |
end; |
5212 |
+ |
|
5213 |
|
procedure TIBCustomDataSet.SetSQLFiltered(AValue: boolean); |
5214 |
|
begin |
5215 |
|
if FSQLFiltered = AValue then Exit; |
5698 |
|
|
5699 |
|
procedure TIBGenerator.SetQuerySQL; |
5700 |
|
begin |
5701 |
< |
if Database <> nil then |
5701 |
> |
if (Database <> nil) and (FGeneratorName <> '') then |
5702 |
|
FQuery.SQL.Text := Format('Select Gen_ID(%s,%d) From RDB$Database', |
5703 |
|
[QuoteIdentifierIfNeeded(Database.SQLDialect,FGeneratorName),Increment]); |
5704 |
|
end; |
5761 |
|
Owner.FieldByName(FFieldName).AsInteger := GetNextValue; |
5762 |
|
end; |
5763 |
|
|
5764 |
+ |
initialization |
5765 |
+ |
RegisterClasses([TIBArrayField,TIBStringField,TIBBCDField, |
5766 |
+ |
TIBSmallintField,TIBIntegerField,TIBLargeIntField, |
5767 |
+ |
TIBMemoField, TIBDateTimeField, TIBTimeField]); |
5768 |
+ |
|
5769 |
|
|
5770 |
|
end. |