ViewVC Help

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

root/public/ibx/trunk/runtime/IBCustomDataSet.pas

Comparing ibx/trunk/runtime/IBCustomDataSet.pas (file contents):
Revision 5 by tony, Fri Feb 18 16:26:16 2011 UTC vs.
Revision 33 by tony, Sat Jul 18 12:30:52 2015 UTC

#	Line 24 | Line 24
24		{       Corporation. All Rights Reserved.                                }
25		{    Contributor(s): Jeff Overcash                                       }
26		{                                                                        }
27	+	{    IBX For Lazarus (Firebird Express)                                  }
28	+	{    Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
29	+	{    Portions created by MWA Software are copyright McCallum Whyman      }
30	+	{    Associates Ltd 2011 - 2015                                                }
31	+	{                                                                        }
32		{************************************************************************}
33
34		unit IBCustomDataSet;
35
36	+	{$R-}
37	+
38		{$Mode Delphi}
39
40	+	{$IFDEF DELPHI}
41	+	{$DEFINE TDBDFIELD_IS_BCD}
42	+	{$ENDIF}
43	+
44		interface
45
46		uses
47	<	{$IFDEF LINUX }
37	<	unix,
38	<	{$ELSE}
47	>	{$IFDEF WINDOWS }
48		Windows,
49	+	{$ELSE}
50	+	unix,
51		{$ENDIF}
52	<	SysUtils, Classes, Forms, Controls, IBDatabase,
53	<	IBExternals, IB, IBHeader,  IBSQL, Db,
43	<	IBUtils, IBBlob;
52	>	SysUtils, Classes, IBDatabase, IBExternals, IB, IBHeader,  IBSQL, Db,
53	>	IBUtils, IBBlob, IBSQLParser;
54
55		const
56		BufferCacheSize    =  1000;  { Allocate cache in this many record chunks}
#	Line 50 | Line 60 | type
60		TIBCustomDataSet = class;
61		TIBDataSet = class;
62
63	+	{ TIBDataSetUpdateObject }
64	+
65		TIBDataSetUpdateObject = class(TComponent)
66		private
67		FRefreshSQL: TStrings;
#	Line 57 | Line 69 | type
69		protected
70		function GetDataSet: TIBCustomDataSet; virtual; abstract;
71		procedure SetDataSet(ADataSet: TIBCustomDataSet); virtual; abstract;
72	<	procedure Apply(UpdateKind: TUpdateKind); virtual; abstract;
72	>	procedure Apply(UpdateKind: TUpdateKind; buff: PChar); virtual; abstract;
73		function GetSQL(UpdateKind: TUpdateKind): TStrings; virtual; abstract;
74	+	procedure InternalSetParams(Query: TIBSQL; buff: PChar);
75		property DataSet: TIBCustomDataSet read GetDataSet write SetDataSet;
76		public
77		constructor Create(AOwner: TComponent); override;
#	Line 94 | Line 107 | type
107		TRecordData = record
108		rdBookmarkFlag: TBookmarkFlag;
109		rdFieldCount: Short;
110	<	rdRecordNumber: Long;
110	>	rdRecordNumber: Integer;
111		rdCachedUpdateStatus: TCachedUpdateStatus;
112		rdUpdateStatus: TUpdateStatus;
113		rdSavedOffset: DWORD;
#	Line 106 | Line 119 | type
119		{ TIBStringField allows us to have strings longer than 8196 }
120
121		TIBStringField = class(TStringField)
122	+	private
123	+	FInitialised: boolean;
124	+	protected
125	+	procedure SetSize(AValue: Integer); override;
126		public
127		constructor create(AOwner: TComponent); override;
128		class procedure CheckTypeSize(Value: Integer); override;
#	Line 159 | Line 176 | type
176		FFieldName: string;
177		FGeneratorName: string;
178		FIncrement: integer;
162	–	function GetSelectSQL: string;
179		procedure SetIncrement(const AValue: integer);
180		protected
181		function GetNextValue(ADatabase: TIBDatabase; ATransaction: TIBTransaction): integer;
#	Line 167 | Line 183 | type
183		constructor Create(Owner: TIBCustomDataSet);
184		procedure Apply;
185		property Owner: TIBCustomDataSet read FOwner;
170	–	property SelectSQL: string read GetSelectSQL;
186		published
187	<	property GeneratorName: string read FGeneratorName write FGeneratorName;
188	<	property FieldName: string read FFieldName write FFieldName;
187	>	property Generator: string read FGeneratorName write FGeneratorName;
188	>	property Field: string read FFieldName write FFieldName;
189		property Increment: integer read FIncrement write SetIncrement default 1;
190		property ApplyOnEvent: TIBGeneratorApplyOnEvent read FApplyOnEvent write FApplyOnEvent;
191		end;
192
193	+	{TIBControlLink - Allows IB Aware controls to react to dataset state changes}
194	+
195	+	TIBControlLink = class
196	+	private
197	+	FTIBDataSet: TIBCustomDataSet;
198	+	procedure SetIBDataSet(AValue: TIBCustomDataSet);
199	+	protected
200	+	procedure UpdateSQL(Sender: TObject); virtual;
201	+	procedure UpdateParams(Sender: TObject); virtual;
202	+	public
203	+	destructor Destroy; override;
204	+	property IBDataSet: TIBCustomDataSet read FTIBDataSet write SetIBDataSet;
205	+	end;
206	+
207	+	TIBAutoCommit = (acDisabled, acCommitRetaining);
208	+
209		{ TIBCustomDataSet }
210		TIBUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApply, uaApplied);
211
212		TIBUpdateErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
213	<	UpdateKind: TUpdateKind; var UpdateAction: TIBUpdateAction)
213	>	UpdateKind: TUpdateKind; var TheUpdateAction: TIBUpdateAction)
214		of object;
215		TIBUpdateRecordEvent = procedure(DataSet: TDataSet; UpdateKind: TUpdateKind;
216		var UpdateAction: TIBUpdateAction) of object;
217
218		TIBUpdateRecordTypes = set of TCachedUpdateStatus;
219
220	+	TDataSetCloseAction = (dcDiscardChanges, dcSaveChanges);
221	+
222	+	TOnValidatePost = procedure (Sender: TObject; var CancelPost: boolean) of object;
223	+
224		TIBCustomDataSet = class(TDataset)
225		private
226	<	FGenerator: TIBGenerator;
226	>	FAutoCommit: TIBAutoCommit;
227	>	FGenerateParamNames: Boolean;
228	>	FGeneratorField: TIBGenerator;
229		FNeedsRefresh: Boolean;
230		FForcedRefresh: Boolean;
231		FDidActivate: Boolean;
#	Line 213 | Line 250 | type
250		FDeletedRecords: Long;
251		FModelBuffer,
252		FOldBuffer: PChar;
253	+	FOnValidatePost: TOnValidatePost;
254		FOpen: Boolean;
255		FInternalPrepared: Boolean;
256		FQDelete,
#	Line 223 | Line 261 | type
261		FRecordBufferSize: Integer;
262		FRecordCount: Integer;
263		FRecordSize: Integer;
264	+	FDataSetCloseAction: TDataSetCloseAction;
265		FUniDirectional: Boolean;
266		FUpdateMode: TUpdateMode;
267		FUpdateObject: TIBDataSetUpdateObject;
#	Line 240 | Line 279 | type
279		FBeforeTransactionEnd,
280		FAfterTransactionEnd,
281		FTransactionFree: TNotifyEvent;
282	<
282	>	FAliasNameMap: array of string;
283	>	FAliasNameList: array of string;
284	>	FBaseSQLSelect: TStrings;
285	>	FParser: TSelectSQLParser;
286	>	FCloseAction: TTransactionAction;
287	>	FInTransactionEnd: boolean;
288	>	FIBLinks: TList;
289		function GetSelectStmtHandle: TISC_STMT_HANDLE;
290		procedure SetUpdateMode(const Value: TUpdateMode);
291		procedure SetUpdateObject(Value: TIBDataSetUpdateObject);
#	Line 253 | Line 298 | type
298		function CanRefresh: Boolean;
299		procedure CheckEditState;
300		procedure ClearBlobCache;
301	+	procedure ClearIBLinks;
302		procedure CopyRecordBuffer(Source, Dest: Pointer);
303		procedure DoBeforeDatabaseDisconnect(Sender: TObject);
304		procedure DoAfterDatabaseDisconnect(Sender: TObject);
305		procedure DoDatabaseFree(Sender: TObject);
306	<	procedure DoBeforeTransactionEnd(Sender: TObject);
306	>	procedure DoBeforeTransactionEnd(Sender: TObject; Action: TTransactionAction);
307		procedure DoAfterTransactionEnd(Sender: TObject);
308		procedure DoTransactionFree(Sender: TObject);
309		procedure FetchCurrentRecordToBuffer(Qry: TIBSQL; RecordNumber: Integer;
#	Line 273 | Line 319 | type
319		function GetModifySQL: TStrings;
320		function GetTransaction: TIBTransaction;
321		function GetTRHandle: PISC_TR_HANDLE;
322	+	function GetParser: TSelectSQLParser;
323		procedure InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer); virtual;
324		function InternalLocate(const KeyFields: string; const KeyValues: Variant;
325		Options: TLocateOptions): Boolean; virtual;
326		procedure InternalPostRecord(Qry: TIBSQL; Buff: Pointer); virtual;
327		procedure InternalRevertRecord(RecordNumber: Integer); virtual;
328		function IsVisible(Buffer: PChar): Boolean;
329	+	procedure RegisterIBLink(Sender: TIBControlLink);
330	+	procedure UnRegisterIBLink(Sender: TIBControlLink);
331		procedure SaveOldBuffer(Buffer: PChar);
332		procedure SetBufferChunks(Value: Integer);
333		procedure SetDatabase(Value: TIBDatabase);
#	Line 294 | Line 343 | type
343		procedure RefreshParams;
344		procedure SQLChanging(Sender: TObject); virtual;
345		function AdjustPosition(FCache: PChar; Offset: DWORD;
346	<	Origin: Integer): Integer;
346	>	Origin: Integer): DWORD;
347		procedure ReadCache(FCache: PChar; Offset: DWORD; Origin: Integer;
348		Buffer: PChar);
349		procedure ReadRecordCache(RecordNumber: Integer; Buffer: PChar;
#	Line 311 | Line 360 | type
360		procedure DeactivateTransaction;
361		procedure CheckDatasetClosed;
362		procedure CheckDatasetOpen;
363	+	function CreateParser: TSelectSQLParser; virtual;
364	+	procedure FieldDefsFromQuery(SourceQuery: TIBSQL);
365		function GetActiveBuf: PChar;
366		procedure InternalBatchInput(InputObject: TIBBatchInput); virtual;
367		procedure InternalBatchOutput(OutputObject: TIBBatchOutput); virtual;
#	Line 343 | Line 394 | type
394		procedure ClearCalcFields(Buffer: PChar); override;
395		function AllocRecordBuffer: PChar; override;
396		procedure DoBeforeDelete; override;
397	+	procedure DoAfterDelete; override;
398		procedure DoBeforeEdit; override;
399	+	procedure DoAfterEdit; override;
400		procedure DoBeforeInsert; override;
401		procedure DoAfterInsert; override;
402	+	procedure DoBeforeClose; override;
403	+	procedure DoBeforeOpen; override;
404		procedure DoBeforePost; override;
405	+	procedure DoAfterPost; override;
406		procedure FreeRecordBuffer(var Buffer: PChar); override;
407		procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
408		function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
409		function GetCanModify: Boolean; override;
410		function GetDataSource: TDataSource; override;
411	+	function GetDBAliasName(FieldNo: integer): string;
412	+	function GetFieldDefFromAlias(aliasName: string): TFieldDef;
413		function GetFieldClass(FieldType: TFieldType): TFieldClass; override;
414		function GetRecNo: Integer; override;
415		function GetRecord(Buffer: PChar; GetMode: TGetMode;
416		DoCheck: Boolean): TGetResult; override;
417		function GetRecordCount: Integer; override;
418		function GetRecordSize: Word; override;
419	+	procedure InternalAutoCommit;
420		procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override;
421		procedure InternalCancel; override;
422		procedure InternalClose; override;
#	Line 375 | Line 434 | type
434		procedure InternalSetFieldData(Field: TField; Buffer: Pointer); virtual;
435		procedure InternalSetToRecord(Buffer: PChar); override;
436		function IsCursorOpen: Boolean; override;
437	+	procedure Loaded; override;
438		procedure ReQuery;
439		procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
440		procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
441		procedure SetCachedUpdates(Value: Boolean);
442		procedure SetDataSource(Value: TDataSource);
443	+	procedure SetGenerateParamNames(AValue: Boolean); virtual;
444		procedure SetFieldData(Field : TField; Buffer : Pointer); override;
445		procedure SetFieldData(Field : TField; Buffer : Pointer;
446		NativeFormat : Boolean); overload; override;
#	Line 387 | Line 448 | type
448
449		protected
450		{Likely to be made public by descendant classes}
451	+	property AutoCommit: TIBAutoCommit read FAutoCommit write FAutoCommit default acDisabled;
452		property SQLParams: TIBXSQLDA read GetSQLParams;
453		property Params: TIBXSQLDA read GetSQLParams;
454		property InternalPrepared: Boolean read FInternalPrepared;
#	Line 402 | Line 464 | type
464		property BufferChunks: Integer read FBufferChunks write SetBufferChunks;
465		property CachedUpdates: Boolean read FCachedUpdates write SetCachedUpdates;
466		property UniDirectional: Boolean read FUniDirectional write SetUniDirectional default False;
467	<	property Generator: TIBGenerator read FGenerator write FGenerator;
467	>	property GeneratorField: TIBGenerator read FGeneratorField write FGeneratorField;
468		property DeleteSQL: TStrings read GetDeleteSQL write SetDeleteSQL;
469		property InsertSQL: TStrings read GetInsertSQL write SetInsertSQL;
470		property RefreshSQL: TStrings read GetRefreshSQL write SetRefreshSQL;
#	Line 410 | Line 472 | type
472		property ModifySQL: TStrings read GetModifySQL write SetModifySQL;
473		property UpdateMode: TUpdateMode read FUpdateMode write SetUpdateMode default upWhereAll;
474		property ParamCheck: Boolean read FParamCheck write FParamCheck default True;
475	+	property Parser: TSelectSQLParser read GetParser;
476	+	property BaseSQLSelect: TStrings read FBaseSQLSelect;
477
478		property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect
479		write FBeforeDatabaseDisconnect;
#	Line 423 | Line 487 | type
487		write FAfterTransactionEnd;
488		property TransactionFree: TNotifyEvent read FTransactionFree
489		write FTransactionFree;
490	+	property OnValidatePost: TOnValidatePost read FOnValidatePost write FOnValidatePost;
491
492		public
493		constructor Create(AOwner: TComponent); override;
#	Line 430 | Line 495 | type
495		procedure ApplyUpdates;
496		function CachedUpdateStatus: TCachedUpdateStatus;
497		procedure CancelUpdates;
498	+	function GetFieldPosition(AliasName: string): integer;
499		procedure FetchAll;
500		function LocateNext(const KeyFields: string; const KeyValues: Variant;
501		Options: TLocateOptions): Boolean;
502		procedure RecordModified(Value: Boolean);
503		procedure RevertRecord;
504		procedure Undelete;
505	+	procedure ResetParser;
506	+	function HasParser: boolean;
507
508		{ TDataSet support methods }
509		function BookmarkValid(Bookmark: TBookmark): Boolean; override;
#	Line 446 | Line 514 | type
514		function GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; overload; (*override;*)
515		function GetFieldData(Field : TField; Buffer : Pointer;
516		NativeFormat : Boolean) : Boolean; overload; override;
517	+	property GenerateParamNames: Boolean read FGenerateParamNames write SetGenerateParamNames;
518		function Locate(const KeyFields: string; const KeyValues: Variant;
519		Options: TLocateOptions): Boolean; override;
520		function Lookup(const KeyFields: string; const KeyValues: Variant;
521		const ResultFields: string): Variant; override;
522		function UpdateStatus: TUpdateStatus; override;
523		function IsSequenced: Boolean; override;
524	<
524	>	procedure Post; override;
525	>	function ParamByName(ParamName: String): TIBXSQLVAR;
526		property DBHandle: PISC_DB_HANDLE read GetDBHandle;
527		property TRHandle: PISC_TR_HANDLE read GetTRHandle;
528		property UpdateObject: TIBDataSetUpdateObject read FUpdateObject write SetUpdateObject;
529		property UpdatesPending: Boolean read FUpdatesPending;
530		property UpdateRecordTypes: TIBUpdateRecordTypes read FUpdateRecordTypes
531		write SetUpdateRecordTypes;
532	+	property DataSetCloseAction: TDataSetCloseAction
533	+	read FDataSetCloseAction write FDataSetCloseAction;
534
535		published
536		property Database: TIBDatabase read GetDatabase write SetDatabase;
#	Line 497 | Line 569 | type
569		write FOnUpdateRecord;
570		end;
571
572	<	TIBDataSet = class(TIBCustomDataSet)
572	>	TIBParserDataSet = class(TIBCustomDataSet)
573	>	public
574	>	property Parser;
575	>	end;
576	>
577	>	TIBDataSet = class(TIBParserDataSet)
578		private
579		function GetPrepared: Boolean;
580
#	Line 522 | Line 599 | type
599		property QModify;
600		property StatementType;
601		property SelectStmtHandle;
602	+	property BaseSQLSelect;
603
604		published
605		{ TIBCustomDataSet }
606	+	property AutoCommit;
607		property BufferChunks;
608		property CachedUpdates;
609		property DeleteSQL;
#	Line 532 | Line 611 | type
611		property RefreshSQL;
612		property SelectSQL;
613		property ModifySQL;
614	<	property Generator;
614	>	property GeneratorField;
615	>	property GenerateParamNames;
616		property ParamCheck;
617		property UniDirectional;
618		property Filtered;
619	+	property DataSetCloseAction;
620
621		property BeforeDatabaseDisconnect;
622		property AfterDatabaseDisconnect;
#	Line 571 | Line 652 | type
652		property OnFilterRecord;
653		property OnNewRecord;
654		property OnPostError;
655	+	property OnValidatePost;
656		end;
657
658		{ TIBDSBlobStream }
659		TIBDSBlobStream = class(TStream)
660	+	private
661	+	FHasWritten: boolean;
662		protected
663		FField: TField;
664		FBlobStream: TIBBlobStream;
665		public
666		constructor Create(AField: TField; ABlobStream: TIBBlobStream;
667		Mode: TBlobStreamMode);
668	+	destructor Destroy; override;
669		function Read(var Buffer; Count: Longint): Longint; override;
670		function Seek(Offset: Longint; Origin: Word): Longint; override;
671		procedure SetSize(NewSize: Longint); override;
#	Line 629 | Line 714 | DefaultFieldClasses: array[TFieldType] o
714		TIBBCDField,       {ftFMTBcd}
715		nil,  {ftFixedWideChar}
716		TWideMemoField);   {ftWideMemo}
717	<
718	<	(*    TADTField,          { ftADT }
717	>	(*
718	>	TADTField,          { ftADT }
719		TArrayField,        { ftArray }
720		TReferenceField,    { ftReference }
721		TDataSetField,     { ftDataSet }
#	Line 639 | Line 724 | DefaultFieldClasses: array[TFieldType] o
724		TVariantField,      { ftVariant }
725		TInterfaceField,    { ftInterface }
726		TIDispatchField,     { ftIDispatch }
727	<	TGuidField);        { ftGuid }*)
727	>	TGuidField);        { ftGuid } *)
728		(*var
729		CreateProviderProc: function(DataSet: TIBCustomDataSet): IProvider = nil;*)
730
#	Line 668 | Line 753 | type
753		NextRelation : TRelationNode;
754		end;
755
756	+	{ TIBControlLink }
757	+
758	+	destructor TIBControlLink.Destroy;
759	+	begin
760	+	IBDataSet := nil;
761	+	inherited Destroy;
762	+	end;
763	+
764	+	procedure TIBControlLink.UpdateParams(Sender: TObject);
765	+	begin
766	+
767	+	end;
768	+
769	+	procedure TIBControlLink.UpdateSQL(Sender: TObject);
770	+	begin
771	+
772	+	end;
773	+
774	+	procedure TIBControlLink.SetIBDataSet(AValue: TIBCustomDataSet);
775	+	begin
776	+	if FTIBDataSet = AValue then Exit;
777	+	if IBDataSet <> nil then
778	+	IBDataSet.UnRegisterIBLink(self);
779	+	FTIBDataSet := AValue;
780	+	if IBDataSet <> nil then
781	+	IBDataSet.RegisterIBLink(self);
782	+	end;
783	+
784
785		{ TIBStringField}
786
787	<	constructor TIBStringField.Create(AOwner: TComponent);
787	>	constructor TIBStringField.create(AOwner: TComponent);
788		begin
789		inherited Create(AOwner);
790		end;
#	Line 728 | Line 841 | begin
841		end;
842		end;
843
844	+	procedure TIBStringField.SetSize(AValue: Integer);
845	+	var FieldSize: integer;
846	+	begin
847	+	if csLoading in ComponentState then
848	+	FInitialised := true;
849	+	if FInitialised then
850	+	inherited SetSize(AValue)
851	+	else
852	+	begin
853	+	{IBCustomDataSet encodes the CharWidth size in the size}
854	+	FieldSize := AValue div 4;
855	+	inherited SetSize(FieldSize);
856	+	DisplayWidth := FieldSize div ((AValue mod 4) + 1);
857	+	FInitialised := true;
858	+	end;
859	+	end;
860	+
861		{ TIBBCDField }
862
863		constructor TIBBCDField.Create(AOwner: TComponent);
#	Line 770 | Line 900 | end;
900
901		function TIBBCDField.GetDataSize: Integer;
902		begin
903	+	{$IFDEF TBCDFIELD_IS_BCD}
904		Result := 8;
905	+	{$ELSE}
906	+	Result := inherited GetDataSize
907	+	{$ENDIF}
908		end;
909
910		{ TIBDataLink }
#	Line 821 | Line 955 | begin
955		CheckIBLoaded;
956		FIBLoaded := True;
957		FBase := TIBBase.Create(Self);
958	+	FIBLinks := TList.Create;
959		FCurrentRecord := -1;
960		FDeletedRecords := 0;
961		FUniDirectional := False;
962		FBufferChunks := BufferCacheSize;
963		FBlobStreamList := TList.Create;
964	<	FGenerator := TIBGenerator.Create(self);
964	>	FGeneratorField := TIBGenerator.Create(self);
965		FDataLink := TIBDataLink.Create(Self);
966		FQDelete := TIBSQL.Create(Self);
967		FQDelete.OnSQLChanging := SQLChanging;
#	Line 845 | Line 980 | begin
980		FQModify.GoToFirstRecordOnExecute := False;
981		FUpdateRecordTypes := [cusUnmodified, cusModified, cusInserted];
982		FParamCheck := True;
983	+	FGenerateParamNames := False;
984		FForcedRefresh := False;
985	+	FAutoCommit:= acDisabled;
986	+	FDataSetCloseAction := dcDiscardChanges;
987		{Bookmark Size is Integer for IBX}
988		BookmarkSize := SizeOf(Integer);
989		FBase.BeforeDatabaseDisconnect := DoBeforeDatabaseDisconnect;
#	Line 859 | Line 997 | begin
997		else
998		if AOwner is TIBTransaction then
999		Transaction := TIBTransaction(AOwner);
1000	+	FBaseSQLSelect := TStringList.Create;
1001		end;
1002
1003		destructor TIBCustomDataSet.Destroy;
1004		begin
1005	+	if Active then Active := false;
1006		if FIBLoaded then
1007		begin
1008	<	if assigned(FGenerator) then FGenerator.Free;
1008	>	if assigned(FGeneratorField) then FGeneratorField.Free;
1009		FDataLink.Free;
1010		FBase.Free;
1011		ClearBlobCache;
1012	+	ClearIBLinks;
1013	+	FIBLinks.Free;
1014		FBlobStreamList.Free;
1015		FreeMem(FBufferCache);
1016		FBufferCache := nil;
#	Line 878 | Line 1020 | begin
1020		FOldCacheSize := 0;
1021		FMappedFieldPosition := nil;
1022		end;
1023	+	if assigned(FBaseSQLSelect) then FBaseSQLSelect.Free;
1024	+	if assigned(FParser) then FParser.Free;
1025		inherited Destroy;
1026		end;
1027
#	Line 919 | Line 1063 | end;
1063
1064		procedure TIBCustomDataSet.ApplyUpdates;
1065		var
1066	+	{$IF FPC_FULLVERSION >= 20700 }
1067	+	CurBookmark: TBookmark;
1068	+	{$ELSE}
1069		CurBookmark: string;
1070	+	{$ENDIF}
1071		Buffer: PRecordData;
1072		CurUpdateTypes: TIBUpdateRecordTypes;
1073		UpdateAction: TIBUpdateAction;
#	Line 979 | Line 1127 | var
1127		procedure UpdateUsingUpdateObject;
1128		begin
1129		try
1130	<	FUpdateObject.Apply(UpdateKind);
1130	>	FUpdateObject.Apply(UpdateKind,PChar(Buffer));
1131		ResetBufferUpdateStatus;
1132		except
1133		on E: Exception do
#	Line 1117 | Line 1265 | begin
1265		end;
1266		end;
1267
1268	+	function TIBCustomDataSet.GetFieldPosition(AliasName: string): integer;
1269	+	var i: integer;
1270	+	Prepared: boolean;
1271	+	begin
1272	+	Result := 0;
1273	+	Prepared := FInternalPrepared;
1274	+	if not Prepared then
1275	+	InternalPrepare;
1276	+	try
1277	+	for i := 0 to Length(FAliasNameList) - 1 do
1278	+	if FAliasNameList[i] = AliasName then
1279	+	begin
1280	+	Result := i + 1;
1281	+	Exit
1282	+	end;
1283	+	finally
1284	+	if not Prepared then
1285	+	InternalUnPrepare;
1286	+	end;
1287	+	end;
1288	+
1289		procedure TIBCustomDataSet.ActivateConnection;
1290		begin
1291		if not Assigned(Database) then
#	Line 1177 | Line 1346 | begin
1346		IBError(ibxeDatasetClosed, [nil]);
1347		end;
1348
1349	+	function TIBCustomDataSet.CreateParser: TSelectSQLParser;
1350	+	begin
1351	+	Result := TSelectSQLParser.Create(self,FBaseSQLSelect);
1352	+	Result.OnSQLChanging := SQLChanging
1353	+	end;
1354	+
1355		procedure TIBCustomDataSet.CheckNotUniDirectional;
1356		begin
1357		if UniDirectional then
#	Line 1280 | Line 1455 | begin
1455		FDatabaseFree(Sender);
1456		end;
1457
1458	<	procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject);
1458	>	procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject;
1459	>	Action: TTransactionAction);
1460		begin
1461	<	if Active then
1462	<	Active := False;
1461	>	FCloseAction := Action;
1462	>	FInTransactionEnd := true;
1463	>	try
1464	>	if Active then
1465	>	Active := False;
1466	>	finally
1467	>	FInTransactionEnd := false;
1468	>	end;
1469		if FQSelect <> nil then
1470		FQSelect.FreeHandle;
1471		if FQDelete <> nil then
#	Line 1321 | Line 1503 | var
1503		LocalData: Pointer;
1504		LocalDate, LocalDouble: Double;
1505		LocalInt: Integer;
1506	+	LocalBool: wordBool;
1507		LocalInt64: Int64;
1508		LocalCurrency: Currency;
1509		FieldsLoaded: Integer;
#	Line 1465 | Line 1648 | begin
1648		end;
1649		end;
1650		end;
1651	+	SQL_BOOLEAN:
1652	+	begin
1653	+	LocalBool:= false;
1654	+	rdFields[j].fdDataSize := SizeOf(wordBool);
1655	+	if RecordNumber >= 0 then
1656	+	LocalBool := Qry.Current[i].AsBoolean;
1657	+	LocalData := PChar(@LocalBool);
1658	+	end;
1659		else { SQL_TEXT, SQL_BLOB, SQL_ARRAY, SQL_QUAD }
1660		begin
1661		rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
#	Line 1589 | Line 1780 | end;
1780		procedure TIBCustomDataSet.InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer);
1781		begin
1782		if (Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukDelete).Text <> '')) then
1783	<	FUpdateObject.Apply(ukDelete)
1783	>	FUpdateObject.Apply(ukDelete,Buff)
1784		else
1785		begin
1786		SetInternalSQLParams(FQDelete, Buff);
#	Line 1606 | Line 1797 | end;
1797		function TIBCustomDataSet.InternalLocate(const KeyFields: string;
1798		const KeyValues: Variant; Options: TLocateOptions): Boolean;
1799		var
1800	<	fl: TList;
1800	>	keyFieldList: TList;
1801	>	{$IF FPC_FULLVERSION >= 20700 }
1802	>	CurBookmark: TBookmark;
1803	>	{$ELSE}
1804		CurBookmark: string;
1805	<	fld, val: Variant;
1806	<	i, fld_cnt: Integer;
1805	>	{$ENDIF}
1806	>	fieldValue: Variant;
1807	>	lookupValues: array of variant;
1808	>	i, fieldCount: Integer;
1809	>	fieldValueAsString: string;
1810	>	lookupValueAsString: string;
1811		begin
1812	<	fl := TList.Create;
1812	>	keyFieldList := TList.Create;
1813		try
1814	<	GetFieldList(fl, KeyFields);
1815	<	fld_cnt := fl.Count;
1814	>	GetFieldList(keyFieldList, KeyFields);
1815	>	fieldCount := keyFieldList.Count;
1816		CurBookmark := Bookmark;
1817	<	result := False;
1818	<	while ((not result) and (not EOF)) do
1817	>	result := false;
1818	>	SetLength(lookupValues, fieldCount);
1819	>	if not EOF then
1820		begin
1821	<	i := 0;
1623	<	result := True;
1624	<	while (result and (i < fld_cnt)) do
1821	>	for i := 0 to fieldCount - 1 do  {expand key values into lookupValues array}
1822		begin
1823	<	if fld_cnt > 1 then
1824	<	val := KeyValues[i]
1823	>	if VarIsArray(KeyValues) then
1824	>	lookupValues[i] := KeyValues[i]
1825	>	else
1826	>	if i > 0 then
1827	>	lookupValues[i] := NULL
1828		else
1829	<	val := KeyValues;
1830	<	fld := TField(fl[i]).Value;
1831	<	result := not (VarIsNull(val) xor VarIsNull(fld));
1832	<	if result and not VarIsNull(val) then
1829	>	lookupValues[0] := KeyValues;
1830	>
1831	>	{convert to upper case is case insensitive search}
1832	>	if (TField(keyFieldList[i]).DataType = ftString) and
1833	>	not VarIsNull(lookupValues[i]) and (loCaseInsensitive in Options) then
1834	>	lookupValues[i] := UpperCase(lookupValues[i]);
1835	>	end;
1836	>	end;
1837	>	while not result and not EOF do   {search for a matching record}
1838	>	begin
1839	>	i := 0;
1840	>	result := true;
1841	>	while result and (i < fieldCount) do
1842	>	{see if all of the key fields matches}
1843	>	begin
1844	>	fieldValue := TField(keyFieldList[i]).Value;
1845	>	result := not (VarIsNull(fieldValue) xor VarIsNull(lookupValues[i]));
1846	>	if result and not VarIsNull(fieldValue) then
1847		begin
1848		try
1849	<	fld := VarAsType(fld, VarType(val));
1636	<	except
1637	<	on E: EVariantError do result := False;
1638	<	end;
1639	<	if Result then
1640	<	if TField(fl[i]).DataType = ftString then
1849	>	if TField(keyFieldList[i]).DataType = ftString then
1850		begin
1851	+	{strings need special handling because of the locate options that
1852	+	apply to them}
1853	+	fieldValueAsString := TField(keyFieldList[i]).AsString;
1854	+	lookupValueAsString := lookupValues[i];
1855		if (loCaseInsensitive in Options) then
1856	<	begin
1857	<	fld := AnsiUpperCase(fld);
1645	<	val := AnsiUpperCase(val);
1646	<	end;
1647	<	fld := TrimRight(fld);
1648	<	val := TrimRight(val);
1856	>	fieldValueAsString := UpperCase(fieldValueAsString);
1857	>
1858		if (loPartialKey in Options) then
1859	<	result := result and (AnsiPos(val, fld) = 1)
1859	>	result := result and (Pos(lookupValueAsString, fieldValueAsString) = 1)
1860		else
1861	<	result := result and (val = fld);
1862	<	end else
1863	<	result := result and (val = fld);
1861	>	result := result and (fieldValueAsString = lookupValueAsString);
1862	>	end
1863	>	else
1864	>	result := result and (lookupValues[i] =
1865	>	VarAsType(fieldValue, VarType(lookupValues[i])));
1866	>	except on EVariantError do
1867	>	result := False;
1868	>	end;
1869		end;
1870		Inc(i);
1871		end;
1872		if not result then
1873	<	Next;
1873	>	Next;
1874		end;
1875		if not result then
1876		Bookmark := CurBookmark
1877		else
1878		CursorPosChanged;
1879		finally
1880	<	fl.Free;
1880	>	keyFieldList.Free;
1881	>	SetLength(lookupValues,0)
1882		end;
1883		end;
1884
#	Line 1691 | Line 1906 | begin
1906		if Assigned(FUpdateObject) then
1907		begin
1908		if (Qry = FQDelete) then
1909	<	FUpdateObject.Apply(ukDelete)
1909	>	FUpdateObject.Apply(ukDelete,Buff)
1910		else if (Qry = FQInsert) then
1911	<	FUpdateObject.Apply(ukInsert)
1911	>	FUpdateObject.Apply(ukInsert,Buff)
1912		else
1913	<	FUpdateObject.Apply(ukModify);
1913	>	FUpdateObject.Apply(ukModify,Buff);
1914		end
1915		else begin
1916		SetInternalSQLParams(Qry, Buff);
#	Line 1712 | Line 1927 | end;
1927		procedure TIBCustomDataSet.InternalRefreshRow;
1928		var
1929		Buff: PChar;
1715	–	SetCursor: Boolean;
1930		ofs: DWORD;
1931		Qry: TIBSQL;
1932		begin
1933	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1720	<	if SetCursor then
1721	<	Screen.Cursor := crHourGlass;
1933	>	FBase.SetCursor;
1934		try
1935		Buff := GetActiveBuf;
1936		if CanRefresh then
#	Line 1762 | Line 1974 | begin
1974		else
1975		IBError(ibxeCannotRefresh, [nil]);
1976		finally
1977	<	if SetCursor and (Screen.Cursor = crHourGlass) then
1766	<	Screen.Cursor := crDefault;
1977	>	FBase.RestoreCursor;
1978		end;
1979		end;
1980
#	Line 1834 | Line 2045 | end;
2045
2046		procedure TIBCustomDataSet.InternalPrepare;
2047		var
1837	–	SetCursor: Boolean;
2048		DidActivate: Boolean;
2049		begin
2050		if FInternalPrepared then
2051		Exit;
2052		DidActivate := False;
2053	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1844	<	if SetCursor then
1845	<	Screen.Cursor := crHourGlass;
2053	>	FBase.SetCursor;
2054		try
2055		ActivateConnection;
2056		DidActivate := ActivateTransaction;
2057		FBase.CheckDatabase;
2058		FBase.CheckTransaction;
2059	+	if HasParser and (FParser.SQLText <> FQSelect.SQL.Text) then
2060	+	FQSelect.SQL.Text := FParser.SQLText;
2061	+	//   writeln( FQSelect.SQL.Text);
2062		if FQSelect.SQL.Text <> '' then
2063		begin
2064		if not FQSelect.Prepared then
2065		begin
2066	+	FQSelect.GenerateParamNames := FGenerateParamNames;
2067		FQSelect.ParamCheck := ParamCheck;
2068		FQSelect.Prepare;
2069		end;
2070	<	if (FQDelete.SQL.Text <> '') and (not FQDelete.Prepared) then
2070	>	FQDelete.GenerateParamNames := FGenerateParamNames;
2071	>	if (Trim(FQDelete.SQL.Text) <> '') and (not FQDelete.Prepared) then
2072		FQDelete.Prepare;
2073	<	if (FQInsert.SQL.Text <> '') and (not FQInsert.Prepared) then
2073	>	FQInsert.GenerateParamNames := FGenerateParamNames;
2074	>	if (Trim(FQInsert.SQL.Text) <> '') and (not FQInsert.Prepared) then
2075		FQInsert.Prepare;
2076	<	if (FQRefresh.SQL.Text <> '') and (not FQRefresh.Prepared) then
2076	>	FQRefresh.GenerateParamNames := FGenerateParamNames;
2077	>	if (Trim(FQRefresh.SQL.Text) <> '') and (not FQRefresh.Prepared) then
2078		FQRefresh.Prepare;
2079	<	if (FQModify.SQL.Text <> '') and (not FQModify.Prepared) then
2079	>	FQModify.GenerateParamNames := FGenerateParamNames;
2080	>	if (Trim(FQModify.SQL.Text) <> '') and (not FQModify.Prepared) then
2081		FQModify.Prepare;
2082		FInternalPrepared := True;
2083		InternalInitFieldDefs;
#	Line 1870 | Line 2086 | begin
2086		finally
2087		if DidActivate then
2088		DeactivateTransaction;
2089	<	if SetCursor and (Screen.Cursor = crHourGlass) then
1874	<	Screen.Cursor := crDefault;
2089	>	FBase.RestoreCursor;
2090		end;
2091		end;
2092
#	Line 2061 | Line 2276 | begin
2276		end;
2277		SQL_TIMESTAMP:
2278		Qry.Params[i].AsDateTime :=
2279	<	TimeStampToDateTime(
2280	<	MSecsToTimeStamp(PDouble(data)^));
2279	>	TimeStampToDateTime(MSecsToTimeStamp(trunc(PDouble(data)^)));
2280	>	SQL_BOOLEAN:
2281	>	Qry.Params[i].AsBoolean := PWordBool(data)^;
2282		end;
2283		end;
2284		end;
#	Line 2088 | Line 2304 | begin
2304		begin
2305		Disconnect;
2306		FQSelect.SQL.Assign(Value);
2307	+	FBaseSQLSelect.assign(Value);
2308		end;
2309		end;
2310
#	Line 2148 | Line 2365 | begin
2365		end;
2366		end;
2367
2368	+	procedure TIBCustomDataSet.RegisterIBLink(Sender: TIBControlLink);
2369	+	begin
2370	+	if FIBLinks.IndexOf(Sender) = -1 then
2371	+	FIBLinks.Add(Sender);
2372	+	end;
2373	+
2374
2375		procedure TIBCustomDataSet.SQLChanging(Sender: TObject);
2376		begin
2377	<	if FOpen then
2378	<	InternalClose;
2377	>	Active := false;
2378	>	{  if FOpen then
2379	>	InternalClose;}
2380		if FInternalPrepared then
2381		InternalUnPrepare;
2382	+	FieldDefs.Clear;
2383	+	FieldDefs.Updated := false;
2384		end;
2385
2386		{ I can "undelete" uninserted records (make them "inserted" again).
#	Line 2183 | Line 2409 | begin
2409		end;
2410		end;
2411
2412	+	procedure TIBCustomDataSet.UnRegisterIBLink(Sender: TIBControlLink);
2413	+	begin
2414	+	FIBLinks.Remove(Sender);
2415	+	end;
2416	+
2417		function TIBCustomDataSet.UpdateStatus: TUpdateStatus;
2418		begin
2419		if Active then
#	Line 2199 | Line 2430 | begin
2430		Result := Assigned( FQSelect ) and FQSelect.EOF;
2431		end;
2432
2433	+	function TIBCustomDataSet.ParamByName(ParamName: String): TIBXSQLVAR;
2434	+	begin
2435	+	ActivateConnection;
2436	+	ActivateTransaction;
2437	+	if not FInternalPrepared then
2438	+	InternalPrepare;
2439	+	Result := Params.ByName(ParamName);
2440	+	end;
2441	+
2442	+	{Beware: the parameter FCache is used as an identifier to determine which
2443	+	cache is being operated on and is not referenced in the computation.
2444	+	The result is an adjusted offset into the identified cache, either the
2445	+	Buffer Cache or the old Buffer Cache.}
2446	+
2447		function TIBCustomDataSet.AdjustPosition(FCache: PChar; Offset: DWORD;
2448	<	Origin: Integer): Integer;
2448	>	Origin: Integer): DWORD;
2449		var
2450		OldCacheSize: Integer;
2451		begin
#	Line 2237 | Line 2482 | procedure TIBCustomDataSet.ReadCache(FCa
2482		Buffer: PChar);
2483		var
2484		pCache: PChar;
2485	+	AdjustedOffset: DWORD;
2486		bOld: Boolean;
2487		begin
2488		bOld := (FCache = FOldBufferCache);
2489	<	pCache := PChar(AdjustPosition(FCache, Offset, Origin));
2489	>	AdjustedOffset := AdjustPosition(FCache, Offset, Origin);
2490		if not bOld then
2491	<	pCache := FBufferCache + Integer(pCache)
2491	>	pCache := FBufferCache + AdjustedOffset
2492		else
2493	<	pCache := FOldBufferCache + Integer(pCache);
2493	>	pCache := FOldBufferCache + AdjustedOffset;
2494		Move(pCache^, Buffer^, DWORD(FRecordBufferSize));
2495		AdjustPosition(FCache, FRecordBufferSize, FILE_CURRENT);
2496		end;
#	Line 2274 | Line 2520 | procedure TIBCustomDataSet.WriteCache(FC
2520		Buffer: PChar);
2521		var
2522		pCache: PChar;
2523	+	AdjustedOffset: DWORD;
2524		bOld: Boolean;
2525		dwEnd: DWORD;
2526		begin
2527		bOld := (FCache = FOldBufferCache);
2528	<	pCache := PChar(AdjustPosition(FCache, Offset, Origin));
2528	>	AdjustedOffset := AdjustPosition(FCache, Offset, Origin);
2529		if not bOld then
2530	<	pCache := FBufferCache + Integer(pCache)
2530	>	pCache := FBufferCache + AdjustedOffset
2531		else
2532	<	pCache := FOldBufferCache + Integer(pCache);
2532	>	pCache := FOldBufferCache + AdjustedOffset;
2533		Move(Buffer^, pCache^, FRecordBufferSize);
2534		dwEnd := AdjustPosition(FCache, FRecordBufferSize, FILE_CURRENT);
2535		if not bOld then
#	Line 2396 | Line 2643 | begin
2643		inherited DoBeforeDelete;
2644		end;
2645
2646	+	procedure TIBCustomDataSet.DoAfterDelete;
2647	+	begin
2648	+	inherited DoAfterDelete;
2649	+	FBase.DoAfterDelete(self);
2650	+	InternalAutoCommit;
2651	+	end;
2652	+
2653		procedure TIBCustomDataSet.DoBeforeEdit;
2654		var
2655		Buff: PRecordData;
#	Line 2410 | Line 2664 | begin
2664		inherited DoBeforeEdit;
2665		end;
2666
2667	+	procedure TIBCustomDataSet.DoAfterEdit;
2668	+	begin
2669	+	inherited DoAfterEdit;
2670	+	FBase.DoAfterEdit(self);
2671	+	end;
2672	+
2673		procedure TIBCustomDataSet.DoBeforeInsert;
2674		begin
2675		if not CanInsert then
#	Line 2419 | Line 2679 | end;
2679
2680		procedure TIBCustomDataSet.DoAfterInsert;
2681		begin
2682	<	if Generator.ApplyOnEvent = gaeOnNewRecord then
2683	<	Generator.Apply;
2682	>	if GeneratorField.ApplyOnEvent = gaeOnNewRecord then
2683	>	GeneratorField.Apply;
2684		inherited DoAfterInsert;
2685	+	FBase.DoAfterInsert(self);
2686	+	end;
2687	+
2688	+	procedure TIBCustomDataSet.DoBeforeClose;
2689	+	begin
2690	+	inherited DoBeforeClose;
2691	+	if State in [dsInsert,dsEdit] then
2692	+	begin
2693	+	if FInTransactionEnd and (FCloseAction = TARollback) then
2694	+	Exit;
2695	+
2696	+	if DataSetCloseAction = dcSaveChanges then
2697	+	Post;
2698	+	{Note this can fail with an exception e.g. due to
2699	+	database validation error. In which case the dataset remains open }
2700	+	end;
2701	+	end;
2702	+
2703	+	procedure TIBCustomDataSet.DoBeforeOpen;
2704	+	var i: integer;
2705	+	begin
2706	+	if assigned(FParser) then
2707	+	FParser.Reset;
2708	+	for i := 0 to FIBLinks.Count - 1 do
2709	+	TIBControlLink(FIBLinks[i]).UpdateSQL(self);
2710	+	inherited DoBeforeOpen;
2711	+	for i := 0 to FIBLinks.Count - 1 do
2712	+	TIBControlLink(FIBLinks[i]).UpdateParams(self);
2713		end;
2714
2715		procedure TIBCustomDataSet.DoBeforePost;
2716		begin
2717		inherited DoBeforePost;
2718		if (State = dsInsert) and
2719	<	(Generator.ApplyOnEvent = gaeOnPostRecord) then
2720	<	Generator.Apply
2719	>	(GeneratorField.ApplyOnEvent = gaeOnPostRecord) then
2720	>	GeneratorField.Apply
2721	>	end;
2722	>
2723	>	procedure TIBCustomDataSet.DoAfterPost;
2724	>	begin
2725	>	inherited DoAfterPost;
2726	>	FBase.DoAfterPost(self);
2727	>	InternalAutoCommit;
2728		end;
2729
2730		procedure TIBCustomDataSet.FetchAll;
2731		var
2732	<	SetCursor: Boolean;
2732	>	{$IF FPC_FULLVERSION >= 20700 }
2733	>	CurBookmark: TBookmark;
2734	>	{$ELSE}
2735		CurBookmark: string;
2736	+	{$ENDIF}
2737		begin
2738	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
2739	<	if SetCursor then
2442	<	Screen.Cursor := crHourGlass;
2443	<	try
2738	>	FBase.SetCursor;
2739	>	try
2740		if FQSelect.EOF or not FQSelect.Open then
2741		exit;
2742		DisableControls;
#	Line 2452 | Line 2748 | begin
2748		EnableControls;
2749		end;
2750		finally
2751	<	if SetCursor and (Screen.Cursor = crHourGlass) then
2456	<	Screen.Cursor := crDefault;
2751	>	FBase.RestoreCursor;
2752		end;
2753		end;
2754
#	Line 2501 | Line 2796 | begin
2796		result := FDataLink.DataSource;
2797		end;
2798
2799	+	function TIBCustomDataSet.GetDBAliasName(FieldNo: integer): string;
2800	+	begin
2801	+	Result := FAliasNameMap[FieldNo-1]
2802	+	end;
2803	+
2804	+	function TIBCustomDataSet.GetFieldDefFromAlias(aliasName: string): TFieldDef;
2805	+	var
2806	+	i: integer;
2807	+	begin
2808	+	Result := nil;
2809	+	for i := 0 to Length(FAliasNameMap) - 1 do
2810	+	if FAliasNameMap[i] = aliasName then
2811	+	begin
2812	+	Result := FieldDefs[i];
2813	+	Exit
2814	+	end;
2815	+	end;
2816	+
2817		function TIBCustomDataSet.GetFieldClass(FieldType: TFieldType): TFieldClass;
2818		begin
2819		Result := DefaultFieldClasses[FieldType];
#	Line 2519 | Line 2832 | begin
2832		result := False;
2833		Buff := GetActiveBuf;
2834		if (Buff = nil) or
2835	<	(not IsVisible(Buff)) then
2835	>	(not IsVisible(Buff)) or not assigned(Field.DataSet) then
2836		exit;
2837		{ The intention here is to stuff the buffer with the data for the
2838		referenced field for the current record }
#	Line 2541 | Line 2854 | begin
2854		Data := Buff + CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs;
2855		if (fdDataType = SQL_VARYING) or (fdDataType = SQL_TEXT) then
2856		begin
2857	<	Move(Data^, Buffer^, fdDataLength);
2858	<	PChar(Buffer)[fdDataLength] := #0;
2857	>	if fdDataLength < Field.DataSize then
2858	>	begin
2859	>	Move(Data^, Buffer^, fdDataLength);
2860	>	PChar(Buffer)[fdDataLength] := #0;
2861	>	end
2862	>	else
2863	>	IBError(ibxeFieldSizeError,[Field.FieldName])
2864		end
2865		else
2866		Move(Data^, Buffer^, Field.DataSize);
#	Line 2585 | Line 2903 | begin
2903		if not Accept and (GetMode = gmCurrent) then
2904		GetMode := gmPrior;
2905		except
2906	<	//        Application.HandleException(Self);
2906	>	//        FBase.HandleException(Self);
2907		end;
2908		end;
2909		RestoreState(SaveState);
#	Line 2679 | Line 2997 | begin
2997		result := FRecordBufferSize;
2998		end;
2999
3000	+	procedure TIBCustomDataSet.InternalAutoCommit;
3001	+	begin
3002	+	with Transaction do
3003	+	if InTransaction and (FAutoCommit = acCommitRetaining) then
3004	+	begin
3005	+	if CachedUpdates then ApplyUpdates;
3006	+	CommitRetaining;
3007	+	end;
3008	+	end;
3009	+
3010		procedure TIBCustomDataSet.InternalAddRecord(Buffer: Pointer; Append: Boolean);
3011		begin
3012		CheckEditState;
#	Line 2756 | Line 3084 | end;
3084		procedure TIBCustomDataSet.InternalDelete;
3085		var
3086		Buff: PChar;
2759	–	SetCursor: Boolean;
3087		begin
3088	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
2762	<	if SetCursor then
2763	<	Screen.Cursor := crHourGlass;
3088	>	FBase.SetCursor;
3089		try
3090		Buff := GetActiveBuf;
3091		if CanDelete then
#	Line 2785 | Line 3110 | begin
3110		end else
3111		IBError(ibxeCannotDelete, [nil]);
3112		finally
3113	<	if SetCursor and (Screen.Cursor = crHourGlass) then
2789	<	Screen.Cursor := crDefault;
3113	>	FBase.RestoreCursor;
3114		end;
3115		end;
3116
#	Line 2802 | Line 3126 | end;
3126
3127		procedure TIBCustomDataSet.InternalHandleException;
3128		begin
3129	<	Application.HandleException(Self)
3129	>	FBase.HandleException(Self)
3130		end;
3131
3132		procedure TIBCustomDataSet.InternalInitFieldDefs;
3133	+	begin
3134	+	if not InternalPrepared then
3135	+	begin
3136	+	InternalPrepare;
3137	+	exit;
3138	+	end;
3139	+	FieldDefsFromQuery(FQSelect);
3140	+	end;
3141	+
3142	+	procedure TIBCustomDataSet.FieldDefsFromQuery(SourceQuery: TIBSQL);
3143		const
3144		DefaultSQL = 'Select F.RDB$COMPUTED_BLR, ' + {do not localize}
3145		'F.RDB$DEFAULT_VALUE, R.RDB$FIELD_NAME ' + {do not localize}
#	Line 2817 | Line 3151 | const
3151		var
3152		FieldType: TFieldType;
3153		FieldSize: Word;
3154	+	CharSetSize: integer;
3155		FieldNullable : Boolean;
3156		i, FieldPosition, FieldPrecision: Integer;
3157	<	FieldAliasName: string;
3157	>	FieldAliasName, DBAliasName: string;
3158		RelationName, FieldName: string;
3159		Query : TIBSQL;
3160		FieldIndex: Integer;
#	Line 2919 | Line 3254 | var
3254		end;
3255
3256		begin
2922	–	if not InternalPrepared then
2923	–	begin
2924	–	InternalPrepare;
2925	–	exit;
2926	–	end;
3257		FRelationNodes := TRelationNode.Create;
3258		FNeedsRefresh := False;
3259		Database.InternalTransaction.StartTransaction;
#	Line 2934 | Line 3264 | begin
3264		FieldDefs.BeginUpdate;
3265		FieldDefs.Clear;
3266		FieldIndex := 0;
3267	<	if (Length(FMappedFieldPosition) < FQSelect.Current.Count) then
3268	<	SetLength(FMappedFieldPosition, FQSelect.Current.Count);
3267	>	if (Length(FMappedFieldPosition) < SourceQuery.Current.Count) then
3268	>	SetLength(FMappedFieldPosition, SourceQuery.Current.Count);
3269		Query.SQL.Text := DefaultSQL;
3270		Query.Prepare;
3271	<	for i := 0 to FQSelect.Current.Count - 1 do
3272	<	with FQSelect.Current[i].Data^ do
3271	>	SetLength(FAliasNameMap, SourceQuery.Current.Count);
3272	>	SetLength(FAliasNameList, SourceQuery.Current.Count);
3273	>	for i := 0 to SourceQuery.Current.Count - 1 do
3274	>	with SourceQuery.Current[i].Data^ do
3275		begin
3276		{ Get the field name }
3277	<	SetString(FieldAliasName, aliasname, aliasname_length);
3277	>	FieldAliasName := SourceQuery.Current[i].Name;
3278	>	SetString(DBAliasName, aliasname, aliasname_length);
3279		SetString(RelationName, relname, relname_length);
3280		SetString(FieldName, sqlname, sqlname_length);
3281	+	FAliasNameList[i] := DBAliasName;
3282		FieldSize := 0;
3283		FieldPrecision := 0;
3284	<	FieldNullable := FQSelect.Current[i].IsNullable;
3284	>	FieldNullable := SourceQuery.Current[i].IsNullable;
3285		case sqltype and not 1 of
3286		{ All VARCHAR's must be converted to strings before recording
3287		their values }
3288		SQL_VARYING, SQL_TEXT:
3289		begin
3290	<	FieldSize := sqllen;
3290	>	CharSetSize := FBase.GetCharSetSize(sqlsubtype and $FF);
3291	>	{FieldSize is encoded for strings - see TIBStringField.SetSize for decode}
3292	>	FieldSize := sqllen * 4 + (CharSetSize - 1);
3293		FieldType := ftString;
3294		end;
3295		{ All Doubles/Floats should be cast to doubles }
#	Line 2980 | Line 3316 | begin
3316		FieldSize := -sqlscale;
3317		end
3318		else
3319	<	FieldType := ftFloat;
3319	>	if Database.SQLDialect = 1 then
3320	>	FieldType := ftFloat
3321	>	else
3322	>	if (FieldCount > i) and (Fields[i] is TFloatField) then
3323	>	FieldType := ftFloat
3324	>	else
3325	>	begin
3326	>	FieldType := ftFMTBCD;
3327	>	FieldPrecision := 9;
3328	>	FieldSize := -sqlscale;
3329		end;
3330	+	end;
3331	+
3332		SQL_INT64:
3333		begin
3334		if (sqlscale = 0) then
#	Line 2993 | Line 3340 | begin
3340		FieldSize := -sqlscale;
3341		end
3342		else
3343	<	FieldType := ftFloat;
3344	<	end;
3343	>	FieldType := ftFloat
3344	>	end;
3345		SQL_TIMESTAMP: FieldType := ftDateTime;
3346		SQL_TYPE_TIME: FieldType := ftTime;
3347		SQL_TYPE_DATE: FieldType := ftDate;
#	Line 3011 | Line 3358 | begin
3358		FieldSize := sizeof (TISC_QUAD);
3359		FieldType := ftUnknown;
3360		end;
3361	+	SQL_BOOLEAN:
3362	+	FieldType:= ftBoolean;
3363		else
3364		FieldType := ftUnknown;
3365		end;
#	Line 3021 | Line 3370 | begin
3370		Inc(FieldIndex);
3371		with FieldDefs.AddFieldDef do
3372		begin
3373	<	Name := string( FieldAliasName );
3374	<	(*           FieldNo := FieldPosition;*)
3373	>	Name := FieldAliasName;
3374	>	FAliasNameMap[FieldNo-1] := DBAliasName;
3375		DataType := FieldType;
3376		Size := FieldSize;
3377		Precision := FieldPrecision;
#	Line 3107 | Line 3456 | begin
3456		else case cur_field.DataType of
3457		ftString:
3458		cur_param.AsString := cur_field.AsString;
3459	<	ftBoolean, ftSmallint, ftWord:
3459	>	ftBoolean:
3460	>	cur_param.AsBoolean := cur_field.AsBoolean;
3461	>	ftSmallint, ftWord:
3462		cur_param.AsShort := cur_field.AsInteger;
3463		ftInteger:
3464		cur_param.AsLong := cur_field.AsInteger;
#	Line 3160 | Line 3511 | begin
3511		end;
3512
3513		procedure TIBCustomDataSet.InternalOpen;
3163	–	var
3164	–	SetCursor: Boolean;
3514
3515		function RecordDataLength(n: Integer): Long;
3516		begin
#	Line 3169 | Line 3518 | var
3518		end;
3519
3520		begin
3521	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3173	<	if SetCursor then
3174	<	Screen.Cursor := crHourGlass;
3521	>	FBase.SetCursor;
3522		try
3523		ActivateConnection;
3524		ActivateTransaction;
#	Line 3232 | Line 3579 | begin
3579		else
3580		FQSelect.ExecQuery;
3581		finally
3582	<	if SetCursor and (Screen.Cursor = crHourGlass) then
3236	<	Screen.Cursor := crDefault;
3582	>	FBase.RestoreCursor;
3583		end;
3584		end;
3585
#	Line 3241 | Line 3587 | procedure TIBCustomDataSet.InternalPost;
3587		var
3588		Qry: TIBSQL;
3589		Buff: PChar;
3244	–	SetCursor: Boolean;
3590		bInserting: Boolean;
3591		begin
3592	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3248	<	if SetCursor then
3249	<	Screen.Cursor := crHourGlass;
3592	>	FBase.SetCursor;
3593		try
3594		Buff := GetActiveBuf;
3595		CheckEditState;
#	Line 3284 | Line 3627 | begin
3627		if bInserting then
3628		Inc(FRecordCount);
3629		finally
3630	<	if SetCursor and (Screen.Cursor = crHourGlass) then
3288	<	Screen.Cursor := crDefault;
3630	>	FBase.RestoreCursor;
3631		end;
3632		end;
3633
#	Line 3305 | Line 3647 | begin
3647		result := FOpen;
3648		end;
3649
3650	+	procedure TIBCustomDataSet.Loaded;
3651	+	begin
3652	+	if assigned(FQSelect) then
3653	+	FBaseSQLSelect.assign(FQSelect.SQL);
3654	+	inherited Loaded;
3655	+	end;
3656	+
3657	+	procedure TIBCustomDataSet.Post;
3658	+	var CancelPost: boolean;
3659	+	begin
3660	+	CancelPost := false;
3661	+	if assigned(FOnValidatePost) then
3662	+	OnValidatePost(self,CancelPost);
3663	+	if CancelPost then
3664	+	Cancel
3665	+	else
3666	+	inherited Post;
3667	+	end;
3668	+
3669		function TIBCustomDataSet.Locate(const KeyFields: string; const KeyValues: Variant;
3670		Options: TLocateOptions): Boolean;
3671		var
3672	+	{$IF FPC_FULLVERSION >= 20700 }
3673	+	CurBookmark: TBookmark;
3674	+	{$ELSE}
3675		CurBookmark: string;
3676	+	{$ENDIF}
3677		begin
3678		DisableControls;
3679		try
#	Line 3326 | Line 3691 | function TIBCustomDataSet.Lookup(const K
3691		const ResultFields: string): Variant;
3692		var
3693		fl: TList;
3694	+	{$IF FPC_FULLVERSION >= 20700 }
3695	+	CurBookmark: TBookmark;
3696	+	{$ELSE}
3697		CurBookmark: string;
3698	+	{$ENDIF}
3699		begin
3700		DisableControls;
3701		fl := TList.Create;
#	Line 3379 | Line 3748 | end;
3748		procedure TIBCustomDataSet.InternalSetFieldData(Field: TField; Buffer: Pointer);
3749		var
3750		Buff, TmpBuff: PChar;
3751	+	MappedFieldPos: integer;
3752		begin
3753		Buff := GetActiveBuf;
3754		if Field.FieldNo < 0 then
#	Line 3395 | Line 3765 | begin
3765		begin
3766		{ If inserting, Adjust record position }
3767		AdjustRecordOnInsert(Buff);
3768	<	if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and
3769	<	(FMappedFieldPosition[Field.FieldNo - 1] <= rdFieldCount) then
3768	>	MappedFieldPos := FMappedFieldPosition[Field.FieldNo - 1];
3769	>	if (MappedFieldPos > 0) and
3770	>	(MappedFieldPos <= rdFieldCount) then
3771		begin
3772		Field.Validate(Buffer);
3773		if (Buffer = nil) or
3774		(Field is TIBStringField) and (PChar(Buffer)[0] = #0) then
3775	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull := True
3775	>	rdFields[MappedFieldPos].fdIsNull := True
3776		else begin
3777	<	Move(Buffer^, Buff[rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs],
3778	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataSize);
3779	<	if (rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_TEXT) or
3780	<	(rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_VARYING) then
3781	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataLength := StrLen(PChar(Buffer));
3782	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull := False;
3777	>	Move(Buffer^, Buff[rdFields[MappedFieldPos].fdDataOfs],
3778	>	rdFields[MappedFieldPos].fdDataSize);
3779	>	if (rdFields[MappedFieldPos].fdDataType = SQL_TEXT) or
3780	>	(rdFields[MappedFieldPos].fdDataType = SQL_VARYING) then
3781	>	rdFields[MappedFieldPos].fdDataLength := StrLen(PChar(Buffer));
3782	>	rdFields[MappedFieldPos].fdIsNull := False;
3783		if rdUpdateStatus = usUnmodified then
3784		begin
3785		if CachedUpdates then
#	Line 3432 | Line 3803 | begin
3803		end;
3804		end;
3805		if not (State in [dsCalcFields, dsFilter, dsNewValue]) then
3806	<	DataEvent(deFieldChange, Longint(Field));
3806	>	DataEvent(deFieldChange, PtrInt(Field));
3807		end;
3808
3809		procedure TIBCustomDataSet.SetRecNo(Value: Integer);
#	Line 3496 | Line 3867 | begin
3867		FillChar(Buffer[FRecordSize], CalcFieldsSize, 0);
3868		end;
3869
3870	+	procedure TIBCustomDataSet.ClearIBLinks;
3871	+	var i: integer;
3872	+	begin
3873	+	for i := FIBLinks.Count - 1 downto 0 do
3874	+	TIBControlLink(FIBLinks[i]).IBDataSet := nil;
3875	+	end;
3876	+
3877
3878		procedure TIBCustomDataSet.InternalUnPrepare;
3879		begin
#	Line 3503 | Line 3881 | begin
3881		begin
3882		CheckDatasetClosed;
3883		FieldDefs.Clear;
3884	+	FieldDefs.Updated := false;
3885		FInternalPrepared := False;
3886	+	Setlength(FAliasNameList,0);
3887		end;
3888		end;
3889
3890		procedure TIBCustomDataSet.InternalExecQuery;
3891		var
3892		DidActivate: Boolean;
3513	–	SetCursor: Boolean;
3893		begin
3894		DidActivate := False;
3895	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3517	<	if SetCursor then
3518	<	Screen.Cursor := crHourGlass;
3895	>	FBase.SetCursor;
3896		try
3897		ActivateConnection;
3898		DidActivate := ActivateTransaction;
#	Line 3532 | Line 3909 | begin
3909		finally
3910		if DidActivate then
3911		DeactivateTransaction;
3912	<	if SetCursor and (Screen.Cursor = crHourGlass) then
3536	<	Screen.Cursor := crDefault;
3912	>	FBase.RestoreCursor;
3913		end;
3914		end;
3915
#	Line 3542 | Line 3918 | begin
3918		Result := FQSelect.Handle;
3919		end;
3920
3921	+	function TIBCustomDataSet.GetParser: TSelectSQLParser;
3922	+	begin
3923	+	if not assigned(FParser) then
3924	+	FParser := CreateParser;
3925	+	Result := FParser
3926	+	end;
3927	+
3928	+	procedure TIBCustomDataSet.ResetParser;
3929	+	begin
3930	+	if assigned(FParser) then
3931	+	begin
3932	+	FParser.Free;
3933	+	FParser := nil;
3934	+	SQLChanging(nil)
3935	+	end;
3936	+	end;
3937	+
3938	+	function TIBCustomDataSet.HasParser: boolean;
3939	+	begin
3940	+	Result := not (csDesigning in ComponentState) and (FParser <> nil)
3941	+	end;
3942	+
3943	+	procedure TIBCustomDataSet.SetGenerateParamNames(AValue: Boolean);
3944	+	begin
3945	+	if FGenerateParamNames = AValue then Exit;
3946	+	FGenerateParamNames := AValue;
3947	+	Disconnect
3948	+	end;
3949	+
3950		procedure TIBCustomDataSet.InitRecord(Buffer: PChar);
3951		begin
3952		inherited InitRecord(Buffer);
#	Line 3788 | Line 4193 | end;
4193
4194		function TIBCustomDataSet.GetFieldData(Field: TField;
4195		Buffer: Pointer): Boolean;
4196	+	{$IFDEF TBCDFIELD_IS_BCD}
4197		var
4198		lTempCurr : System.Currency;
4199		begin
#	Line 3798 | Line 4204 | begin
4204		CurrToBCD(lTempCurr, TBCD(Buffer^), 32, Field.Size);
4205		end
4206		else
4207	+	{$ELSE}
4208	+	begin
4209	+	{$ENDIF}
4210		Result := InternalGetFieldData(Field, Buffer);
4211		end;
4212
#	Line 3811 | Line 4220 | begin
4220		end;
4221
4222		procedure TIBCustomDataSet.SetFieldData(Field: TField; Buffer: Pointer);
4223	+	{$IFDEF TDBDFIELD_IS_BCD}
4224		var
4225		lTempCurr : System.Currency;
4226		begin
#	Line 3820 | Line 4230 | begin
4230		InternalSetFieldData(Field, @lTempCurr);
4231		end
4232		else
4233	+	{$ELSE}
4234	+	begin
4235	+	{$ENDIF}
4236		InternalSetFieldData(Field, Buffer);
4237		end;
4238
#	Line 3851 | Line 4264 | begin
4264		FRefreshSQL.Assign(Value);
4265		end;
4266
4267	+	procedure TIBDataSetUpdateObject.InternalSetParams(Query: TIBSQL; buff: PChar);
4268	+	begin
4269	+	if not Assigned(DataSet) then Exit;
4270	+	DataSet.SetInternalSQLParams(Query, buff);
4271	+	end;
4272	+
4273		{ TIBDSBlobStream }
4274		constructor TIBDSBlobStream.Create(AField: TField; ABlobStream: TIBBlobStream;
4275		Mode: TBlobStreamMode);
#	Line 3862 | Line 4281 | begin
4281		FBlobStream.Truncate;
4282		end;
4283
4284	+	destructor TIBDSBlobStream.Destroy;
4285	+	begin
4286	+	if FHasWritten then
4287	+	TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
4288	+	inherited Destroy;
4289	+	end;
4290	+
4291		function TIBDSBlobStream.Read(var Buffer; Count: Longint): Longint;
4292		begin
4293		result := FBlobStream.Read(Buffer, Count);
#	Line 3884 | Line 4310 | begin
4310		TIBCustomDataSet(FField.DataSet).RecordModified(True);
4311		TBlobField(FField).Modified := true;
4312		result := FBlobStream.Write(Buffer, Count);
4313	<	TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, Longint(FField));
4313	>	FHasWritten := true;
4314	>	{  TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
4315	>	Removed as this caused a seek to beginning of the blob stream thus corrupting
4316	>	the blob stream. Moved to the destructor i.e. called after blob written}
4317		end;
4318
4319		{ TIBGenerator }
#	Line 3896 | Line 4325 | begin
4325		FIncrement := AValue
4326		end;
4327
3899	–	function TIBGenerator.GetSelectSQL: string;
3900	–	begin
3901	–	Result := FOwner.SelectSQL.Text
3902	–	end;
3903	–
4328		function TIBGenerator.GetNextValue(ADatabase: TIBDatabase;
4329		ATransaction: TIBTransaction): integer;
4330		begin
#	Line 3914 | Line 4338 | begin
4338		IBError(ibxeCannotSetTransaction,[]);
4339		with Transaction do
4340		if not InTransaction then StartTransaction;
4341	<	SQL.Text := Format('Select Gen_ID(%s,%d) as ID From RDB$Database',[GeneratorName,Increment]);
4341	>	SQL.Text := Format('Select Gen_ID(%s,%d) as ID From RDB$Database',[FGeneratorName,Increment]);
4342		Prepare;
4343		ExecQuery;
4344		try
#	Line 3936 | Line 4360 | end;
4360
4361		procedure TIBGenerator.Apply;
4362		begin
4363	<	if (GeneratorName <> '') and (FieldName <> '')  then
4364	<	Owner.FieldByName(FieldName).AsInteger := GetNextValue(Owner.Database,Owner.Transaction);
4363	>	if (FGeneratorName <> '') and (FFieldName <> '') and Owner.FieldByName(FFieldName).IsNull then
4364	>	Owner.FieldByName(FFieldName).AsInteger := GetNextValue(Owner.Database,Owner.Transaction);
4365		end;
4366
4367		end.

Diff Legend

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