ViewVC Help

View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing

root/public/ibx/branches/journaling/runtime/nongui/IBCustomDataSet.pas

Comparing ibx/trunk/runtime/nongui/IBCustomDataSet.pas (file contents):
Revision 312 by tony, Tue Aug 25 15:40:58 2020 UTC vs.
Revision 315 by tony, Thu Feb 25 11:56:36 2021 UTC

#	Line 53 | Line 53 | uses
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;
#	Line 88 | Line 88 | type
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
#	Line 243 | Line 243 | type
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
#	Line 400 | Line 457 | type
457		FArrayCacheOffset: integer;
458		FAutoCommit: TIBAutoCommit;
459		FCaseSensitiveParameterNames: boolean;
460	+	FDefaultTZDate: TDateTime;
461		FEnableStatistics: boolean;
462		FGenerateParamNames: Boolean;
463		FGeneratorField: TIBGenerator;
#	Line 441 | Line 499 | type
499		FRecordCount: Integer;
500		FRecordSize: Integer;
501		FDataSetCloseAction: TDataSetCloseAction;
502	+	FTZTextOption: TTZTextOptions;
503		FSQLFiltered: boolean;
504		FSQLFilterParams: TStrings;
505		FUniDirectional: Boolean;
#	Line 478 | Line 537 | type
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);
#	Line 633 | Line 693 | type
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);
#	Line 656 | Line 717 | type
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
#	Line 671 | Line 734 | type
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		property SQLFiltered: boolean read FSQLFiltered write SetSQLFiltered;
741		property SQLFilterParams: TStrings read FSQLFilterParams write SetSQLFilterParams;
742
#	Line 736 | Line 800 | type
800		property MasterDetailDelay: integer read GetMasterDetailDelay write SetMasterDetailDelay;
801		property DataSetCloseAction: TDataSetCloseAction
802		read FDataSetCloseAction write FDataSetCloseAction;
803	+	property DefaultTZDate: TDateTime read FDefaultTZDate write SetDefaultTZDate;
804
805		public
806		{Performance Statistics}
#	Line 839 | Line 904 | type
904		property UniDirectional;
905		property Filtered;
906		property DataSetCloseAction;
907	+	property TZTextOption;
908	+	property DefaultTZDate;
909		property SQLFiltered;
910		property SQLFilterParams;
911
#	Line 909 | Line 976 | type
976		FCharacterSetName: RawByteString;
977		FCharacterSetSize: integer;
978		FCodePage: TSystemCodePage;
979	+	FHasTimeZone: boolean;
980		FIdentityColumn: boolean;
981		FRelationName: string;
982		FDataSize: integer;
#	Line 921 | Line 989 | type
989		property ArrayDimensions: integer read FArrayDimensions write FArrayDimensions;
990		property ArrayBounds: TArrayBounds read FArrayBounds write FArrayBounds;
991		property IdentityColumn: boolean read FIdentityColumn write FIdentityColumn default false;
992	+	property HasTimeZone: boolean read FHasTimeZone write FHasTimeZone default false;
993		end;
994
995		const
#	Line 928 | Line 997 | const
997		nil,                { ftUnknown }
998		TIBStringField,     { ftString }
999		TIBSmallintField,   { ftSmallint }
1000	<	TIBIntegerField,      { ftInteger }
1000	>	TIBIntegerField,    { ftInteger }
1001		TWordField,         { ftWord }
1002		TBooleanField,      { ftBoolean }
1003		TFloatField,        { ftFloat }
1004		TCurrencyField,     { ftCurrency }
1005		TIBBCDField,        { ftBCD }
1006		TDateField,         { ftDate }
1007	<	TTimeField,         { ftTime }
1008	<	TDateTimeField,     { ftDateTime }
1007	>	TIBTimeField,       { ftTime }
1008	>	TIBDateTimeField,   { ftDateTime }
1009		TBytesField,        { ftBytes }
1010		TVarBytesField,     { ftVarBytes }
1011		TAutoIncField,      { ftAutoInc }
#	Line 949 | Line 1018 | const
1018		TBlobField,         { ftTypedBinary }
1019		nil,                { ftCursor }
1020		TStringField,       { ftFixedChar }
1021	<	nil,    { ftWideString }
1022	<	TIBLargeIntField,     { ftLargeInt }
1023	<	nil,          { ftADT }
1024	<	TIBArrayField,        { ftArray }
1025	<	nil,    { ftReference }
1026	<	nil,     { ftDataSet }
1021	>	nil,                { ftWideString }
1022	>	TIBLargeIntField,   { ftLargeInt }
1023	>	nil,                { ftADT }
1024	>	TIBArrayField,      { ftArray }
1025	>	nil,                { ftReference }
1026	>	nil,                { ftDataSet }
1027		TBlobField,         { ftOraBlob }
1028		TMemoField,         { ftOraClob }
1029		TVariantField,      { ftVariant }
1030	<	nil,    { ftInterface }
1031	<	nil,     { ftIDispatch }
1032	<	TGuidField,        { ftGuid }
1033	<	TDateTimeField,    {ftTimestamp}
1034	<	TIBBCDField,       {ftFMTBcd}
1035	<	nil,  {ftFixedWideChar}
1036	<	nil);   {ftWideMemo}
1030	>	nil,                { ftInterface }
1031	>	nil,                { ftIDispatch }
1032	>	TGuidField,         { ftGuid }
1033	>	TIBDateTimeField,   { ftTimestamp }
1034	>	TFmtBCDField,       { ftFMTBcd }
1035	>	nil,                { ftFixedWideChar }
1036	>	nil);               { ftWideMemo }
1037		(*
1038		TADTField,          { ftADT }
1039		TArrayField,        { ftArray }
#	Line 981 | Line 1050 | const
1050
1051		implementation
1052
1053	<	uses Variants, FmtBCD, LazUTF8, IBMessages, IBQuery;
1053	>	uses Variants, FmtBCD, LazUTF8, IBMessages, IBQuery, DateUtils, dbconst;
1054
1055		type
1056
#	Line 1043 | Line 1112 | type
1112		Result := str;
1113		end;
1114
1115	+	{ TIBDateTimeField }
1116	+
1117	+	function TIBDateTimeField.GetTimeZoneName: string;
1118	+	var aBuffer: TIBBufferedDateTimeWithTimeZone;
1119	+	begin
1120	+	if GetDateTimeBuffer(aBuffer) then
1121	+	Result := GetTimeZoneServices.TimeZoneID2TimeZoneName(aBuffer.TimeZoneID)
1122	+	else
1123	+	Result := '';
1124	+	end;
1125	+
1126	+	function TIBDateTimeField.GetTimeZoneServices: ITimeZoneServices;
1127	+	begin
1128	+	if (FTimeZoneServices = nil) and
1129	+	(DataSet <> nil) and ((DataSet as TIBCustomDataSet).Database <> nil)
1130	+	and ((DataSet as TIBCustomDataSet).Database.attachment <> nil) then
1131	+	FTimeZoneServices := (DataSet as TIBCustomDataSet).Database.attachment.GetTimeZoneServices;
1132	+	Result := FTimeZoneServices;
1133	+	end;
1134	+
1135	+	function TIBDateTimeField.GetDateTimeBuffer(
1136	+	var aBuffer: TIBBufferedDateTimeWithTimeZone): boolean;
1137	+	begin
1138	+	Result := HasTimeZone;
1139	+	if Result then
1140	+	Result := GetData(@aBuffer,False);
1141	+	end;
1142	+
1143	+	function TIBDateTimeField.GetTimeZoneID: TFBTimeZoneID;
1144	+	var aBuffer: TIBBufferedDateTimeWithTimeZone;
1145	+	begin
1146	+	if GetDateTimeBuffer(aBuffer) then
1147	+	Result := aBuffer.TimeZoneID
1148	+	else
1149	+	Result := TimeZoneID_GMT;
1150	+	end;
1151	+
1152	+	procedure TIBDateTimeField.SetTimeZoneID(aValue: TFBTimeZoneID);
1153	+	var aBuffer: TIBBufferedDateTimeWithTimeZone;
1154	+	begin
1155	+	if GetDateTimeBuffer(aBuffer) then
1156	+	SetAsDateTimeTZ(aBuffer.Timestamp,aValue)
1157	+	end;
1158	+
1159	+	procedure TIBDateTimeField.SetTimeZoneName(AValue: string);
1160	+	var aBuffer: TIBBufferedDateTimeWithTimeZone;
1161	+	begin
1162	+	if GetDateTimeBuffer(aBuffer) then
1163	+	SetAsDateTimeTZ(aBuffer.Timestamp,aValue)
1164	+	end;
1165	+
1166	+	procedure TIBDateTimeField.Bind(Binding: Boolean);
1167	+	var IBFieldDef: TIBFieldDef;
1168	+	begin
1169	+	inherited Bind(Binding);
1170	+	if Binding and (FieldDef <> nil) then
1171	+	begin
1172	+	IBFieldDef := FieldDef as TIBFieldDef;
1173	+	FHasTimeZone := IBFieldDef.HasTimeZone;
1174	+	end;
1175	+	end;
1176	+
1177	+	function TIBDateTimeField.GetAsDateTime: TDateTime;
1178	+	var aBuffer: TIBBufferedDateTimeWithTimeZone;
1179	+	begin
1180	+	if GetDateTimeBuffer(aBuffer) then
1181	+	Result := aBuffer.Timestamp
1182	+	else
1183	+	Result := inherited GetAsDateTime;
1184	+	end;
1185	+
1186	+	function TIBDateTimeField.GetAsVariant: variant;
1187	+	var aBuffer: TIBBufferedDateTimeWithTimeZone;
1188	+	begin
1189	+	if GetDateTimeBuffer(aBuffer) then
1190	+	with aBuffer do
1191	+	Result := VarArrayOf([Timestamp,dstOffset,TimeZoneID])
1192	+	else
1193	+	Result := inherited GetAsVariant;
1194	+	end;
1195	+
1196	+	function TIBDateTimeField.GetDataSize: Integer;
1197	+	begin
1198	+	if HasTimeZone then
1199	+	Result := sizeof(TIBBufferedDateTimeWithTimeZone)
1200	+	else
1201	+	Result := inherited GetDataSize;
1202	+	end;
1203	+
1204	+	procedure TIBDateTimeField.GetText(var theText: string; ADisplayText: Boolean);
1205	+	var aBuffer: TIBBufferedDateTimeWithTimeZone;
1206	+	F: string;
1207	+	begin
1208	+	if Dataset = nil then
1209	+	DatabaseErrorFmt(SNoDataset,[FieldName]);
1210	+
1211	+	if GetDateTimeBuffer(aBuffer) then
1212	+	{$if declared(DefaultFormatSettings)}
1213	+	with DefaultFormatSettings do
1214	+	{$else}
1215	+	{$if declared(FormatSettings)}
1216	+	with FormatSettings do
1217	+	{$ifend}
1218	+	{$ifend}
1219	+	begin
1220	+	if ADisplayText and (Length(DisplayFormat) <> 0) then
1221	+	F := DisplayFormat
1222	+	else
1223	+	Case DataType of
1224	+	ftTime : F := LongTimeFormat;
1225	+	ftDate : F := ShortDateFormat;
1226	+	else
1227	+	F := ShortDateFormat + ' ' + LongTimeFormat;
1228	+	end;
1229	+
1230	+	with aBuffer do
1231	+	case (DataSet as TIBCustomDataSet).TZTextOption of
1232	+	tzOffset:
1233	+	TheText := FBFormatDateTime(F,timestamp) + ' ' + FormatTimeZoneOffset(dstOffset);
1234	+	tzGMT:
1235	+	TheText := FBFormatDateTime(F,IncMinute(Timestamp,-dstOffset));
1236	+	tzOriginalID:
1237	+	TheText := FBFormatDateTime(F,timestamp) + ' ' + GetTimeZoneServices.TimeZoneID2TimeZoneName(TimeZoneID);
1238	+	end;
1239	+	end
1240	+	else
1241	+	inherited GetText(theText, ADisplayText);
1242	+	end;
1243	+
1244	+	procedure TIBDateTimeField.SetAsDateTime(AValue: TDateTime);
1245	+	var aBuffer: TIBBufferedDateTimeWithTimeZone;
1246	+	begin
1247	+	if GetDateTimeBuffer(aBuffer) then
1248	+	SetAsDateTimeTZ(AValue,aBuffer.TimeZoneID)
1249	+	else
1250	+	inherited SetAsDateTime(AValue)
1251	+	end;
1252	+
1253	+	procedure TIBDateTimeField.SetAsString(const AValue: string);
1254	+	var aDateTime: TDateTime;
1255	+	aTimeZone: AnsiString;
1256	+	begin
1257	+	if AValue = '' then
1258	+	Clear
1259	+	else
1260	+	if ParseDateTimeTZString(AValue,aDateTime,aTimeZone,DataType=ftTime) then
1261	+	begin
1262	+	if not HasTimeZone or (aTimeZone = '') then
1263	+	SetAsDateTime(aDateTime)
1264	+	else
1265	+	SetAsDateTimeTZ(aDateTime,aTimeZone);
1266	+	end
1267	+	else
1268	+	IBError(ibxeBadDateTimeTZString,[AValue]);
1269	+	end;
1270	+
1271	+	procedure TIBDateTimeField.SetVarValue(const AValue: Variant);
1272	+	begin
1273	+	if HasTimeZone and VarIsArray(AValue)then
1274	+	SetAsDateTimeTZ(AValue[0],string(AValue[2]))
1275	+	else
1276	+	inherited SetVarValue(AValue);
1277	+	end;
1278	+
1279	+	constructor TIBDateTimeField.Create(AOwner: TComponent);
1280	+	begin
1281	+	inherited Create(AOwner);
1282	+	SetDataType(ftDateTime);
1283	+	end;
1284	+
1285	+	function TIBDateTimeField.GetAsDateTimeTZ(var aDateTime: TDateTime;
1286	+	var dstOffset: smallint; var aTimeZoneID: TFBTimeZoneID): boolean;
1287	+	var aBuffer: TIBBufferedDateTimeWithTimeZone;
1288	+	begin
1289	+	Result := GetDateTimeBuffer(aBuffer);
1290	+	if Result then
1291	+	begin
1292	+	aDateTime := aBuffer.Timestamp;
1293	+	dstOffset := aBuffer.dstOffset;
1294	+	aTimeZoneID := aBuffer.TimeZoneID;
1295	+	end
1296	+	else
1297	+	aDateTime := inherited GetAsDateTime
1298	+	end;
1299	+
1300	+	function TIBDateTimeField.GetAsDateTimeTZ(var aDateTime: TDateTime;
1301	+	var dstOffset: smallint; var aTimeZone: string): boolean;
1302	+	var aTimeZoneID: TFBTimeZoneID;
1303	+	begin
1304	+	Result := GetAsDateTimeTZ(aDateTime,dstOffset,aTimeZoneID);
1305	+	if Result then
1306	+	aTimeZone := GetTimeZoneServices.TimeZoneID2TimeZoneName(aTimeZoneID);
1307	+	end;
1308	+
1309	+	function TIBDateTimeField.GetAsUTCDateTime: TDateTime;
1310	+	var aBuffer: TIBBufferedDateTimeWithTimeZone;
1311	+	begin
1312	+	if GetDateTimeBuffer(aBuffer) then
1313	+	Result := IncMinute(aBuffer.timestamp,-aBuffer.dstOffset)
1314	+	else
1315	+	Result := inherited GetAsDateTime;
1316	+	end;
1317	+
1318	+	procedure TIBDateTimeField.SetAsDateTimeTZ(aDateTime: TDateTime;
1319	+	aTimeZoneID: TFBTimeZoneID);
1320	+	var DateTimeBuffer: TIBBufferedDateTimeWithTimeZone;
1321	+	begin
1322	+	if HasTimeZone then
1323	+	begin
1324	+	DateTimeBuffer.Timestamp := aDateTime;
1325	+	DateTimeBuffer.dstOffset := GetTimeZoneServices.GetEffectiveOffsetMins(aDateTime,aTimeZoneID);
1326	+	DateTimeBuffer.TimeZoneID := aTimeZoneID;
1327	+	SetData(@DateTimeBuffer,False);
1328	+	end
1329	+	else
1330	+	inherited SetAsDateTime(aDateTime);
1331	+	end;
1332	+
1333	+	procedure TIBDateTimeField.SetAsDateTimeTZ(aDateTime: TDateTime;
1334	+	aTimeZone: string);
1335	+	begin
1336	+	if HasTimeZone then
1337	+	SetAsDateTimeTZ(aDateTime,GetTimeZoneServices.TimeZoneName2TimeZoneID(aTimeZone))
1338	+	else
1339	+	inherited SetAsDateTime(aDateTime);
1340	+	end;
1341	+
1342	+	{ TIBTimeField }
1343	+
1344	+	constructor TIBTimeField.Create(AOwner: TComponent);
1345	+	begin
1346	+	inherited Create(AOwner);
1347	+	SetDataType(ftTime);
1348	+	end;
1349	+
1350		{ TIBParserDataSet }
1351
1352		procedure TIBParserDataSet.DoBeforeOpen;
#	Line 1586 | Line 1890 | begin
1890		if AOwner is TIBTransaction then
1891		Transaction := TIBTransaction(AOwner);
1892		FBaseSQLSelect := TStringList.Create;
1893	+	FTZTextOption := tzOffset;
1894	+	FDefaultTZDate := EncodeDate(2020,1,1);
1895		FSQLFilterParams := TStringList.Create;
1896		TStringList(FSQLFilterParams).OnChange :=  HandleSQLFilterParamsChanged;
1897		end;
#	Line 1695 | Line 2001 | var
2001
2002		procedure UpdateUsingOnUpdateRecord;
2003		begin
1698	–	UpdateAction := uaFail;
2004		try
2005		FOnUpdateRecord(Self, UpdateKind, UpdateAction);
2006		except
2007		on E: Exception do
2008		begin
2009	+	UpdateAction := uaFail;
2010		if (E is EDatabaseError) and Assigned(FOnUpdateError) then
2011	<	FOnUpdateError(Self, EIBError(E), UpdateKind, UpdateAction);
1706	<	if UpdateAction = uaFail then
1707	<	raise;
2011	>	FOnUpdateError(Self, EDatabaseError(E), UpdateKind, UpdateAction);
2012		end;
2013		end;
2014		end;
#	Line 1713 | Line 2017 | var
2017		begin
2018		try
2019		FUpdateObject.Apply(UpdateKind,PChar(Buffer));
2020	<	ResetBufferUpdateStatus;
2020	>	UpdateAction := uaApplied;
2021		except
2022		on E: Exception do
2023	+	begin
2024	+	UpdateAction := uaFail;
2025		if (E is EDatabaseError) and Assigned(FOnUpdateError) then
2026	<	FOnUpdateError(Self, EIBError(E), UpdateKind, UpdateAction);
2026	>	FOnUpdateError(Self, EDatabaseError(E), UpdateKind, UpdateAction);
2027	>	end;
2028		end;
2029		end;
2030
#	Line 1732 | Line 2039 | var
2039		cusDeleted:
2040		InternalDeleteRecord(FQDelete, Buffer);
2041		end;
2042	+	UpdateAction := uaApplied;
2043		except
2044	<	on E: EIBError do begin
2044	>	on E: Exception do begin
2045		UpdateAction := uaFail;
2046	<	if Assigned(FOnUpdateError) then
2047	<	FOnUpdateError(Self, E, UpdateKind, UpdateAction);
1740	<	case UpdateAction of
1741	<	uaFail: raise;
1742	<	uaAbort: SysUtils.Abort;
1743	<	uaSkip: bRecordsSkipped := True;
1744	<	end;
2046	>	if (E is EDatabaseError) and Assigned(FOnUpdateError) then
2047	>	FOnUpdateError(Self, EDatabaseError(E), UpdateKind, UpdateAction);
2048		end;
2049		end;
2050		end;
#	Line 1763 | Line 2066 | begin
2066		Buffer := PRecordData(GetActiveBuf);
2067		GetUpdateKind;
2068		UpdateAction := uaApply;
2069	<	if Assigned(FUpdateObject) or Assigned(FOnUpdateRecord) then
2069	>	if (Assigned(FOnUpdateRecord)) then
2070	>	UpdateUsingOnUpdateRecord;
2071	>	if UpdateAction = uaApply then
2072		begin
2073	<	if (Assigned(FOnUpdateRecord)) then
2074	<	UpdateUsingOnUpdateRecord
2073	>	if Assigned(FUpdateObject) then
2074	>	UpdateUsingUpdateObject
2075		else
2076	<	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;
2076	>	UpdateUsingInternalquery;
2077		end;
2078	<	if (not Assigned(FUpdateObject)) and (UpdateAction = UaApply) then
2079	<	begin
2080	<	UpdateUsingInternalquery;
2081	<	UpdateAction := uaApplied;
2078	>
2079	>	case UpdateAction of
2080	>	uaFail:
2081	>	IBError(ibxeUserAbort, [nil]);
2082	>	uaAbort:
2083	>	SysUtils.Abort;
2084	>	uaApplied:
2085	>	ResetBufferUpdateStatus;
2086	>	uaSkip:
2087	>	bRecordsSkipped := True;
2088	>	uaRetry:
2089	>	Continue;
2090		end;
2091	+
2092		Next;
2093		end;
2094		FUpdatesPending := bRecordsSkipped;
#	Line 2152 | Line 2453 | begin
2453		SQL_TYPE_DATE,
2454		SQL_TYPE_TIME:
2455		fdDataSize := SizeOf(TDateTime);
2456	+	SQL_TIMESTAMP_TZ,
2457	+	SQL_TIMESTAMP_TZ_EX,
2458	+	SQL_TIME_TZ,
2459	+	SQL_TIME_TZ_EX:
2460	+	fdDataSize := SizeOf(TIBBufferedDateTimeWithTimeZone);
2461		SQL_SHORT, SQL_LONG:
2462		begin
2463		if (fdDataScale = 0) then
#	Line 2179 | Line 2485 | begin
2485		SQL_VARYING,
2486		SQL_TEXT,
2487		SQL_BLOB:
2488	<	fdCodePage := Qry.Metadata[i].getCodePage;
2488	>	fdCodePage := colMetadata.getCodePage;
2489	>	SQL_DEC16,
2490	>	SQL_DEC34,
2491	>	SQL_DEC_FIXED,
2492	>	SQL_INT128:
2493	>	fdDataSize := sizeof(tBCD);
2494		end;
2495		fdDataOfs := FRecordSize;
2496		Inc(FRecordSize, fdDataSize);
#	Line 2212 | Line 2523 | procedure TIBCustomDataSet.ColumnDataToB
2523		ColumnIndex, FieldIndex: integer; Buffer: PChar);
2524		var
2525		LocalData: PByte;
2526	<	LocalDate: TDateTime;
2216	<	LocalDouble: Double;
2217	<	LocalInt: Integer;
2218	<	LocalBool: wordBool;
2219	<	LocalInt64: Int64;
2220	<	LocalCurrency: Currency;
2526	>	BufPtr: PByte;
2527		ColData: ISQLData;
2528		begin
2529		LocalData := nil;
2530		with PRecordData(Buffer)^.rdFields[FieldIndex], FFieldColumns^[FieldIndex] do
2531		begin
2532		QryResults.GetData(ColumnIndex,fdIsNull,fdDataLength,LocalData);
2533	+	BufPtr := PByte(Buffer + fdDataOfs);
2534		if not fdIsNull then
2535		begin
2536		ColData := QryResults[ColumnIndex];
#	Line 2231 | Line 2538 | begin
2538		SQL_TYPE_DATE,
2539		SQL_TYPE_TIME,
2540		SQL_TIMESTAMP:
2234	–	begin
2541		{This is an IBX native format and not the TDataset approach. See also GetFieldData}
2542	<	LocalDate := ColData.AsDateTime;
2543	<	LocalData := PByte(@LocalDate);
2542	>	PDateTime(BufPtr)^ := ColData.AsDateTime;
2543	>
2544	>	SQL_TIMESTAMP_TZ,
2545	>	SQL_TIMESTAMP_TZ_EX:
2546	>	begin
2547	>	with PIBBufferedDateTimeWithTimeZone(Bufptr)^ do
2548	>	ColData.GetAsDateTime(Timestamp,dstOffset,TimeZoneID);
2549	>	end;
2550	>
2551	>	SQL_TIME_TZ,
2552	>	SQL_TIME_TZ_EX:
2553	>	begin
2554	>	with PIBBufferedDateTimeWithTimeZone(Bufptr)^ do
2555	>	ColData.GetAsTime(Timestamp, dstOffset,TimeZoneID, DefaultTZDate);
2556		end;
2557		SQL_SHORT, SQL_LONG:
2558		begin
2559		if (fdDataScale = 0) then
2560	<	begin
2243	<	LocalInt := ColData.AsLong;
2244	<	LocalData := PByte(@LocalInt);
2245	<	end
2560	>	PInteger(BufPtr)^ := ColData.AsLong
2561		else
2562		if (fdDataScale >= (-4)) then
2563	<	begin
2249	<	LocalCurrency := ColData.AsCurrency;
2250	<	LocalData := PByte(@LocalCurrency);
2251	<	end
2563	>	PCurrency(BufPtr)^ := ColData.AsCurrency
2564		else
2565	<	begin
2254	<	LocalDouble := ColData.AsDouble;
2255	<	LocalData := PByte(@LocalDouble);
2256	<	end;
2565	>	PDouble(BufPtr)^ := ColData.AsDouble;
2566		end;
2567		SQL_INT64:
2568		begin
2569		if (fdDataScale = 0) then
2570	<	begin
2262	<	LocalInt64 := ColData.AsInt64;
2263	<	LocalData := PByte(@LocalInt64);
2264	<	end
2570	>	PInt64(BufPtr)^ := ColData.AsInt64
2571		else
2572		if (fdDataScale >= (-4)) then
2573	<	begin
2574	<	LocalCurrency := ColData.AsCurrency;
2575	<	LocalData := PByte(@LocalCurrency);
2270	<	end
2271	<	else
2272	<	begin
2273	<	LocalDouble := ColData.AsDouble;
2274	<	LocalData := PByte(@LocalDouble);
2275	<	end
2573	>	PCurrency(BufPtr)^ := ColData.AsCurrency
2574	>	else
2575	>	PDouble(BufPtr)^ := ColData.AsDouble;
2576		end;
2577	+
2578		SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
2579	<	begin
2580	<	LocalDouble := ColData.AsDouble;
2280	<	LocalData := PByte(@LocalDouble);
2281	<	end;
2579	>	PDouble(BufPtr)^ := ColData.AsDouble;
2580	>
2581		SQL_BOOLEAN:
2582	<	begin
2583	<	LocalBool := ColData.AsBoolean;
2584	<	LocalData := PByte(@LocalBool);
2585	<	end;
2586	<	end;
2582	>	system.PBoolean(BufPtr)^ := ColData.AsBoolean;
2583	>
2584	>	SQL_DEC16,
2585	>	SQL_DEC34,
2586	>	SQL_DEC_FIXED,
2587	>	SQL_INT128:
2588	>	pBCD(BufPtr)^ := ColData.GetAsBCD;
2589
2289	–	if fdDataType = SQL_VARYING then
2290	–	Move(LocalData^, Buffer[fdDataOfs], fdDataLength)
2590		else
2591	<	Move(LocalData^, Buffer[fdDataOfs], fdDataSize)
2591	>	begin
2592	>	if fdDataType = SQL_VARYING then
2593	>	Move(LocalData^, BufPtr^, fdDataLength)
2594	>	else
2595	>	Move(LocalData^, BufPtr^, fdDataSize)
2596	>	end;
2597	>	end; {case}
2598		end
2599		else {Null column}
2600		if fdDataType = SQL_VARYING then
2601	<	FillChar(Buffer[fdDataOfs],fdDataLength,0)
2601	>	FillChar(BufPtr^,fdDataLength,0)
2602		else
2603	<	FillChar(Buffer[fdDataOfs],fdDataSize,0);
2603	>	FillChar(BufPtr^,fdDataSize,0);
2604		end;
2605		end;
2606
#	Line 2892 | Line 3197 | end;
3197		procedure TIBCustomDataSet.SetInternalSQLParams(Params: ISQLParams; Buffer: Pointer);
3198		var
3199		i, j: Integer;
3200	<	cr, data: PChar;
3200	>	cr, data: PByte;
3201		fn: string;
3202		st: RawByteString;
3203		OldBuffer: Pointer;
#	Line 2942 | Line 3247 | begin
3247		case fdDataType of
3248		SQL_TEXT, SQL_VARYING:
3249		begin
3250	<	SetString(st, data, fdDataLength);
3250	>	SetString(st, PAnsiChar(data), fdDataLength);
3251		SetCodePage(st,fdCodePage,false);
3252		Param.AsString := st;
3253		end;
#	Line 2975 | Line 3280 | begin
3280		SQL_TIMESTAMP:
3281		{This is an IBX native format and not the TDataset approach. See also SetFieldData}
3282		Param.AsDateTime := PDateTime(data)^;
3283	+	SQL_TIMESTAMP_TZ_EX,
3284	+	SQL_TIMESTAMP_TZ:
3285	+	with PIBBufferedDateTimeWithTimeZone(data)^ do
3286	+	Param.SetAsDateTime(Timestamp,TimeZoneID);
3287	+	SQL_TIME_TZ_EX,
3288	+	SQL_TIME_TZ:
3289	+	with PIBBufferedDateTimeWithTimeZone(data)^ do
3290	+	Param.SetAsTime(Timestamp,DefaultTZDate,TimeZoneID);
3291		SQL_BOOLEAN:
3292		Param.AsBoolean := PWordBool(data)^;
3293	+	SQL_DEC16,
3294	+	SQL_DEC34,
3295	+	SQL_DEC_FIXED,
3296	+	SQL_INT128:
3297	+	Param.AsBCD := pBCD(data)^;
3298	+	else
3299	+	IBError(ibxeUnknownSQLType,[fdDataType]);
3300		end;
3301		end;
3302		end;
#	Line 3232 | Line 3552 | end;
3552		procedure TIBCustomDataSet.ReadRecordCache(RecordNumber: Integer; Buffer: PChar;
3553		ReadOldBuffer: Boolean);
3554		begin
3555	+	if RecordNumber = -1 then
3556	+	Exit; {nothing to do}
3557		if FUniDirectional then
3558		RecordNumber := RecordNumber mod UniCache;
3559		if (ReadOldBuffer) then
#	Line 3397 | Line 3719 | end;
3719		procedure TIBCustomDataSet.SetArrayIntf(AnArray: IArray; Field: TIBArrayField);
3720		var Buff: PChar;
3721		pda: PArrayDataArray;
3722	+	MappedFieldPos: integer;
3723		begin
3724		if (Field = nil) or (Field.DataSet <> self) then
3725		IBError(ibxFieldNotinDataSet,[Field.Name,Name]);
3726		Buff := GetActiveBuf;
3727		if Buff <> nil then
3728	+	with PRecordData(Buff)^ do
3729		begin
3730		AdjustRecordOnInsert(Buff);
3731	<	pda := PArrayDataArray(Buff + FArrayCacheOffset);
3732	<	pda^[Field.FCacheOffset].FArray := AnArray;
3733	<	WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Pointer(Buff));
3731	>	MappedFieldPos := FMappedFieldPosition[Field.FieldNo - 1];
3732	>	if (MappedFieldPos > 0) and
3733	>	(MappedFieldPos <= rdFieldCount) then
3734	>	begin
3735	>	rdFields[MappedFieldPos].fdIsNull := AnArray = nil;
3736	>	pda := PArrayDataArray(Buff + FArrayCacheOffset);
3737	>	if pda^[Field.FCacheOffset] = nil then
3738	>	begin
3739	>	if not rdFields[MappedFieldPos].fdIsNull then
3740	>	begin
3741	>	pda^[Field.FCacheOffset] := TIBArray.Create(Field,AnArray);
3742	>	FArrayList.Add(pda^[Field.FCacheOffset]);
3743	>	end
3744	>	end
3745	>	else
3746	>	pda^[Field.FCacheOffset].FArray := AnArray;
3747	>	WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Pointer(Buff));
3748	>	end;
3749		end;
3750		end;
3751
#	Line 3613 | Line 3952 | end;
3952
3953		function TIBCustomDataSet.InternalGetFieldData(Field: TField; Buffer: Pointer): Boolean;
3954		var
3955	<	Buff, Data: PChar;
3955	>	Buff: PChar;
3956	>	Data: PByte;
3957		CurrentRecord: PRecordData;
3958		begin
3959		result := False;
#	Line 3640 | Line 3980 | begin
3980		result := not fdIsNull;
3981		if result and (Buffer <> nil) then
3982		begin
3983	<	Data := Buff + fdDataOfs;
3983	>	Data := PByte(Buff) + fdDataOfs;
3984		if (fdDataType = SQL_VARYING) or (fdDataType = SQL_TEXT) then
3985		begin
3986		if fdDataLength <= Field.DataSize then
#	Line 3860 | Line 4200 | begin
4200		if FDidActivate then
4201		DeactivateTransaction;
4202		FQSelect.Close;
4203	<	ClearBlobCache;
3864	<	ClearArrayCache;
4203	>	ResetBufferCache;
4204		FreeRecordBuffer(FModelBuffer);
4205		FreeRecordBuffer(FOldBuffer);
4206		FCurrentRecord := -1;
4207		FOpen := False;
3869	–	FRecordCount := 0;
3870	–	FDeletedRecords := 0;
4208		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;
4209		FreeMem(FFieldColumns);
4210		FFieldColumns := nil;
3882	–	FreeMem(FOldBufferCache);
3883	–	FOldBufferCache := nil;
4211		BindFields(False);
4212		ResetParser;
4213		if DefaultFields then DestroyFields;
#	Line 3981 | Line 4308 | var
4308		aArrayDimensions: integer;
4309		aArrayBounds: TArrayBounds;
4310		ArrayMetaData: IArrayMetaData;
4311	+	FieldHasTimeZone: boolean;
4312
4313		function Add_Node(Relation, Field : String) : TRelationNode;
4314		var
#	Line 4133 | Line 4461 | begin
4461		FieldDataSize := GetSize;
4462		FieldPrecision := 0;
4463		FieldNullable := IsNullable;
4464	+	FieldHasTimeZone := false;
4465		CharSetSize := 0;
4466		CharSetName := '';
4467		FieldCodePage := CP_NONE;
#	Line 4181 | Line 4510 | begin
4510		FieldType := ftFloat
4511		else
4512		begin
4513	<	FieldType := ftFMTBCD;
4513	>	FieldType := ftBCD;
4514		FieldPrecision := 9;
4515		FieldSize := -getScale;
4516		end;
#	Line 4203 | Line 4532 | begin
4532		SQL_TIMESTAMP: FieldType := ftDateTime;
4533		SQL_TYPE_TIME: FieldType := ftTime;
4534		SQL_TYPE_DATE: FieldType := ftDate;
4535	+	SQL_TIMESTAMP_TZ,
4536	+	SQL_TIMESTAMP_TZ_EX:
4537	+	begin
4538	+	FieldType := ftDateTime;
4539	+	FieldHasTimeZone := true;
4540	+	end;
4541	+	SQL_TIME_TZ,
4542	+	SQL_TIME_TZ_EX:
4543	+	begin
4544	+	FieldType := ftTime;
4545	+	FieldHasTimeZone := true;
4546	+	end;
4547		SQL_BLOB:
4548		begin
4549		FieldSize := sizeof (TISC_QUAD);
#	Line 4230 | Line 4571 | begin
4571		end;
4572		SQL_BOOLEAN:
4573		FieldType:= ftBoolean;
4574	+
4575	+	SQL_DEC16:
4576	+	begin
4577	+	FieldType := ftFmtBCD;
4578	+	FieldPrecision := 16;
4579	+	FieldSize := 4; {For conversions from currency type}
4580	+	end;
4581	+
4582	+	SQL_DEC34:
4583	+	begin
4584	+	FieldType := ftFmtBCD;
4585	+	FieldPrecision := 34;
4586	+	FieldSize := 4; {For conversions from currency type}
4587	+	end;
4588	+
4589	+	SQL_DEC_FIXED,
4590	+	SQL_INT128:
4591	+	begin
4592	+	FieldType := ftFmtBCD;
4593	+	FieldPrecision := 38;
4594	+	FieldSize := -getScale; {For conversions from currency type}
4595	+	end;
4596	+
4597		else
4598		FieldType := ftUnknown;
4599		end;
#	Line 4253 | Line 4617 | begin
4617		CodePage := FieldCodePage;
4618		ArrayDimensions := aArrayDimensions;
4619		ArrayBounds := aArrayBounds;
4620	+	HasTimezone := FieldHasTimeZone;
4621		if (FieldName <> '') and (RelationName <> '') then
4622		begin
4623		IdentityColumn := Is_IDENTITY_COLUMN(RelationName, FieldName);
#	Line 4351 | Line 4716 | begin
4716		ftDate:
4717		cur_param.AsDate := cur_field.AsDateTime;
4718		ftTime:
4719	<	cur_param.AsTime := cur_field.AsDateTime;
4719	>	if (cur_field is TIBDateTimeField) and TIBDateTimeField(cur_field).HasTimeZone
4720	>	and (cur_param.GetSQLType = SQL_TIME_TZ) then
4721	>	cur_param.SetAsTime(cur_Field.asDateTime,DefaultTZDate,TIBDateTimeField(cur_field).TimeZoneID)
4722	>	else
4723	>	cur_param.AsTime := cur_field.AsDateTime;
4724		ftDateTime:
4725	<	cur_param.AsDateTime := cur_field.AsDateTime;
4725	>	begin
4726	>	if (cur_field is TIBDateTimeField) and TIBDateTimeField(cur_field).HasTimeZone
4727	>	and (cur_param.GetSQLType = SQL_TIMESTAMP_TZ) then
4728	>	cur_param.SetAsDateTime(cur_field.AsDateTime,TIBDateTimeField(cur_field).TimeZoneID)
4729	>	else
4730	>	cur_param.AsDateTime := cur_field.AsDateTime;
4731	>	end;
4732		ftBlob, ftMemo:
4733		begin
4734		s := nil;
#	Line 4367 | Line 4742 | begin
4742		end;
4743		ftArray:
4744		cur_param.AsArray := TIBArrayField(cur_field).ArrayIntf;
4745	+	ftFmtBCD:
4746	+	cur_param.AsBCD := TFmtBCDField(cur_field).AsBCD;
4747		else
4748		IBError(ibxeNotSupported, [nil]);
4749		end;
#	Line 4392 | Line 4769 | begin
4769		First;
4770		end;
4771
4772	+	procedure TIBCustomDataSet.ResetBufferCache;
4773	+	begin
4774	+	ClearBlobCache;
4775	+	ClearArrayCache;
4776	+	FRecordCount := 0;
4777	+	FDeletedRecords := 0;
4778	+	FBPos := 0;
4779	+	FOBPos := 0;
4780	+	FCacheSize := 0;
4781	+	FOldCacheSize := 0;
4782	+	FBEnd := 0;
4783	+	FOBEnd := 0;
4784	+	FreeMem(FBufferCache);
4785	+	FBufferCache := nil;
4786	+	FreeMem(FOldBufferCache);
4787	+	FOldBufferCache := nil;
4788	+	end;
4789	+
4790		procedure TIBCustomDataSet.InternalOpen;
4791
4792		function RecordDataLength(n: Integer): Long;
#	Line 4599 | Line 4994 | end;
4994
4995		procedure TIBCustomDataSet.SetBookmarkData(Buffer: PChar; Data: Pointer);
4996		begin
4997	<	PRecordData(Buffer)^.rdRecordNumber := PInteger(Data)^;
4997	>	if Data <> nil then
4998	>	PRecordData(Buffer)^.rdRecordNumber := PInteger(Data)^;
4999		end;
5000
5001		procedure TIBCustomDataSet.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
#	Line 4811 | Line 5207 | begin
5207		FQSelect.CaseSensitiveParameterNames := AValue;
5208		end;
5209
5210	+	procedure TIBCustomDataSet.SetDefaultTZDate(AValue: TDateTime);
5211	+	begin
5212	+	FDefaultTZDate := DateOf(AValue);
5213	+	end;
5214	+
5215		procedure TIBCustomDataSet.SetSQLFiltered(AValue: boolean);
5216		begin
5217		if FSQLFiltered = AValue then Exit;
#	Line 5299 | Line 5700 | end;
5700
5701		procedure TIBGenerator.SetQuerySQL;
5702		begin
5703	<	if Database <> nil then
5703	>	if (Database <> nil) and (FGeneratorName <> '') then
5704		FQuery.SQL.Text := Format('Select Gen_ID(%s,%d) From RDB$Database',
5705		[QuoteIdentifierIfNeeded(Database.SQLDialect,FGeneratorName),Increment]);
5706		end;
#	Line 5362 | Line 5763 | begin
5763		Owner.FieldByName(FFieldName).AsInteger := GetNextValue;
5764		end;
5765
5766	+	initialization
5767	+	RegisterClasses([TIBArrayField,TIBStringField,TIBBCDField,
5768	+	TIBSmallintField,TIBIntegerField,TIBLargeIntField,
5769	+	TIBMemoField, TIBDateTimeField, TIBTimeField]);
5770	+
5771
5772		end.

Diff Legend

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