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 35 by tony, Tue Jan 26 14:38:47 2016 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	+	FCharacterSetName: string;
124	+	FCharacterSetSize: integer;
125	+	protected
126	+	function GetDefaultWidth: Longint; override;
127		public
128	<	constructor create(AOwner: TComponent); override;
128	>	constructor Create(aOwner: TComponent); override;
129		class procedure CheckTypeSize(Value: Integer); override;
130		function GetAsString: string; override;
131		function GetAsVariant: Variant; override;
132		function GetValue(var Value: string): Boolean;
133		procedure SetAsString(const Value: string); override;
134	+	property CharacterSetName: string read FCharacterSetName write FCharacterSetName;
135	+	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
136	+	end;
137	+
138	+	{ TIBWideStringField }
139	+
140	+	TIBWideStringField = class(TWideStringField)
141	+	private
142	+	FCharacterSetName: string;
143	+	FCharacterSetSize: integer;
144	+	public
145	+	property CharacterSetName: string read FCharacterSetName write FCharacterSetName;
146	+	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
147		end;
148
149		{ TIBBCDField }
#	Line 135 | Line 166 | type
166		property Size default 8;
167		end;
168
169	+	{TIBMemoField}
170	+	{Allows us to show truncated text in DBGrids and anything else that uses
171	+	DisplayText}
172	+
173	+	TIBMemoField = class(TMemoField)
174	+	private
175	+	FCharacterSetName: string;
176	+	FCharacterSetSize: integer;
177	+	FDisplayTextAsClassName: boolean;
178	+	function GetTruncatedText: string;
179	+	protected
180	+	function GetDefaultWidth: Longint; override;
181	+	procedure GetText(var AText: string; ADisplayText: Boolean); override;
182	+	public
183	+	constructor Create(AOwner: TComponent); override;
184	+	property CharacterSetName: string read FCharacterSetName write FCharacterSetName;
185	+	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
186	+	published
187	+	property DisplayTextAsClassName: boolean read FDisplayTextAsClassName
188	+	write FDisplayTextAsClassName;
189	+	end;
190	+
191	+	{ TIBWideMemoField }
192	+
193	+	TIBWideMemoField = class(TWideMemoField)
194	+	private
195	+	FCharacterSetName: string;
196	+	FCharacterSetSize: integer;
197	+	FDisplayTextAsClassName: boolean;
198	+	function GetTruncatedText: string;
199	+	protected
200	+	function GetDefaultWidth: Longint; override;
201	+	procedure GetText(var AText: string; ADisplayText: Boolean); override;
202	+	public
203	+	constructor Create(AOwner: TComponent); override;
204	+	property CharacterSetName: string read FCharacterSetName write FCharacterSetName;
205	+	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
206	+	published
207	+	property DisplayTextAsClassName: boolean read FDisplayTextAsClassName
208	+	write FDisplayTextAsClassName;
209	+	end;
210	+
211		TIBDataLink = class(TDetailDataLink)
212		private
213		FDataSet: TIBCustomDataSet;
#	Line 159 | Line 232 | type
232		FFieldName: string;
233		FGeneratorName: string;
234		FIncrement: integer;
162	–	function GetSelectSQL: string;
235		procedure SetIncrement(const AValue: integer);
236		protected
237		function GetNextValue(ADatabase: TIBDatabase; ATransaction: TIBTransaction): integer;
#	Line 167 | Line 239 | type
239		constructor Create(Owner: TIBCustomDataSet);
240		procedure Apply;
241		property Owner: TIBCustomDataSet read FOwner;
170	–	property SelectSQL: string read GetSelectSQL;
242		published
243	<	property GeneratorName: string read FGeneratorName write FGeneratorName;
244	<	property FieldName: string read FFieldName write FFieldName;
243	>	property Generator: string read FGeneratorName write FGeneratorName;
244	>	property Field: string read FFieldName write FFieldName;
245		property Increment: integer read FIncrement write SetIncrement default 1;
246		property ApplyOnEvent: TIBGeneratorApplyOnEvent read FApplyOnEvent write FApplyOnEvent;
247		end;
248
249	+	{TIBControlLink - Allows IB Aware controls to react to dataset state changes}
250	+
251	+	TIBControlLink = class
252	+	private
253	+	FTIBDataSet: TIBCustomDataSet;
254	+	procedure SetIBDataSet(AValue: TIBCustomDataSet);
255	+	protected
256	+	procedure UpdateSQL(Sender: TObject); virtual;
257	+	procedure UpdateParams(Sender: TObject); virtual;
258	+	public
259	+	destructor Destroy; override;
260	+	property IBDataSet: TIBCustomDataSet read FTIBDataSet write SetIBDataSet;
261	+	end;
262	+
263	+	TIBAutoCommit = (acDisabled, acCommitRetaining);
264	+
265		{ TIBCustomDataSet }
266		TIBUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApply, uaApplied);
267
268		TIBUpdateErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
269	<	UpdateKind: TUpdateKind; var UpdateAction: TIBUpdateAction)
269	>	UpdateKind: TUpdateKind; var TheUpdateAction: TIBUpdateAction)
270		of object;
271		TIBUpdateRecordEvent = procedure(DataSet: TDataSet; UpdateKind: TUpdateKind;
272		var UpdateAction: TIBUpdateAction) of object;
273
274		TIBUpdateRecordTypes = set of TCachedUpdateStatus;
275
276	+	TDataSetCloseAction = (dcDiscardChanges, dcSaveChanges);
277	+
278	+	TOnValidatePost = procedure (Sender: TObject; var CancelPost: boolean) of object;
279	+
280		TIBCustomDataSet = class(TDataset)
281		private
282	<	FGenerator: TIBGenerator;
282	>	FAutoCommit: TIBAutoCommit;
283	>	FGenerateParamNames: Boolean;
284	>	FGeneratorField: TIBGenerator;
285		FNeedsRefresh: Boolean;
286		FForcedRefresh: Boolean;
287		FDidActivate: Boolean;
#	Line 213 | Line 306 | type
306		FDeletedRecords: Long;
307		FModelBuffer,
308		FOldBuffer: PChar;
309	+	FOnValidatePost: TOnValidatePost;
310		FOpen: Boolean;
311		FInternalPrepared: Boolean;
312		FQDelete,
#	Line 223 | Line 317 | type
317		FRecordBufferSize: Integer;
318		FRecordCount: Integer;
319		FRecordSize: Integer;
320	+	FDataSetCloseAction: TDataSetCloseAction;
321		FUniDirectional: Boolean;
322		FUpdateMode: TUpdateMode;
323		FUpdateObject: TIBDataSetUpdateObject;
#	Line 240 | Line 335 | type
335		FBeforeTransactionEnd,
336		FAfterTransactionEnd,
337		FTransactionFree: TNotifyEvent;
338	<
338	>	FAliasNameMap: array of string;
339	>	FAliasNameList: array of string;
340	>	FBaseSQLSelect: TStrings;
341	>	FParser: TSelectSQLParser;
342	>	FCloseAction: TTransactionAction;
343	>	FInTransactionEnd: boolean;
344	>	FIBLinks: TList;
345		function GetSelectStmtHandle: TISC_STMT_HANDLE;
346		procedure SetUpdateMode(const Value: TUpdateMode);
347		procedure SetUpdateObject(Value: TIBDataSetUpdateObject);
#	Line 253 | Line 354 | type
354		function CanRefresh: Boolean;
355		procedure CheckEditState;
356		procedure ClearBlobCache;
357	+	procedure ClearIBLinks;
358		procedure CopyRecordBuffer(Source, Dest: Pointer);
359		procedure DoBeforeDatabaseDisconnect(Sender: TObject);
360		procedure DoAfterDatabaseDisconnect(Sender: TObject);
361		procedure DoDatabaseFree(Sender: TObject);
362	<	procedure DoBeforeTransactionEnd(Sender: TObject);
362	>	procedure DoBeforeTransactionEnd(Sender: TObject; Action: TTransactionAction);
363		procedure DoAfterTransactionEnd(Sender: TObject);
364		procedure DoTransactionFree(Sender: TObject);
365		procedure FetchCurrentRecordToBuffer(Qry: TIBSQL; RecordNumber: Integer;
#	Line 273 | Line 375 | type
375		function GetModifySQL: TStrings;
376		function GetTransaction: TIBTransaction;
377		function GetTRHandle: PISC_TR_HANDLE;
378	+	function GetParser: TSelectSQLParser;
379		procedure InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer); virtual;
380		function InternalLocate(const KeyFields: string; const KeyValues: Variant;
381		Options: TLocateOptions): Boolean; virtual;
382		procedure InternalPostRecord(Qry: TIBSQL; Buff: Pointer); virtual;
383		procedure InternalRevertRecord(RecordNumber: Integer); virtual;
384		function IsVisible(Buffer: PChar): Boolean;
385	+	procedure RegisterIBLink(Sender: TIBControlLink);
386	+	procedure UnRegisterIBLink(Sender: TIBControlLink);
387		procedure SaveOldBuffer(Buffer: PChar);
388		procedure SetBufferChunks(Value: Integer);
389		procedure SetDatabase(Value: TIBDatabase);
#	Line 292 | Line 397 | type
397		procedure SetUpdateRecordTypes(Value: TIBUpdateRecordTypes);
398		procedure SetUniDirectional(Value: Boolean);
399		procedure RefreshParams;
295	–	procedure SQLChanging(Sender: TObject); virtual;
400		function AdjustPosition(FCache: PChar; Offset: DWORD;
401	<	Origin: Integer): Integer;
401	>	Origin: Integer): DWORD;
402		procedure ReadCache(FCache: PChar; Offset: DWORD; Origin: Integer;
403		Buffer: PChar);
404		procedure ReadRecordCache(RecordNumber: Integer; Buffer: PChar;
#	Line 311 | Line 415 | type
415		procedure DeactivateTransaction;
416		procedure CheckDatasetClosed;
417		procedure CheckDatasetOpen;
418	+	function CreateParser: TSelectSQLParser; virtual;
419	+	procedure FieldDefsFromQuery(SourceQuery: TIBSQL);
420		function GetActiveBuf: PChar;
421		procedure InternalBatchInput(InputObject: TIBBatchInput); virtual;
422		procedure InternalBatchOutput(OutputObject: TIBBatchOutput); virtual;
#	Line 320 | Line 426 | type
426		procedure InternalRefreshRow; virtual;
427		procedure InternalSetParamsFromCursor; virtual;
428		procedure CheckNotUniDirectional;
429	+	procedure SQLChanging(Sender: TObject); virtual;
430	+	procedure SQLChanged(Sender: TObject); virtual;
431
432		(*    { IProviderSupport }
433		procedure PSEndTransaction(Commit: Boolean); override;
#	Line 343 | Line 451 | type
451		procedure ClearCalcFields(Buffer: PChar); override;
452		function AllocRecordBuffer: PChar; override;
453		procedure DoBeforeDelete; override;
454	+	procedure DoAfterDelete; override;
455		procedure DoBeforeEdit; override;
456	+	procedure DoAfterEdit; override;
457		procedure DoBeforeInsert; override;
458		procedure DoAfterInsert; override;
459	+	procedure DoBeforeClose; override;
460	+	procedure DoBeforeOpen; override;
461		procedure DoBeforePost; override;
462	+	procedure DoAfterPost; override;
463		procedure FreeRecordBuffer(var Buffer: PChar); override;
464		procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
465		function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
466		function GetCanModify: Boolean; override;
467		function GetDataSource: TDataSource; override;
468	+	function GetDBAliasName(FieldNo: integer): string;
469	+	function GetFieldDefFromAlias(aliasName: string): TFieldDef;
470		function GetFieldClass(FieldType: TFieldType): TFieldClass; override;
471		function GetRecNo: Integer; override;
472		function GetRecord(Buffer: PChar; GetMode: TGetMode;
473		DoCheck: Boolean): TGetResult; override;
474		function GetRecordCount: Integer; override;
475		function GetRecordSize: Word; override;
476	+	procedure InternalAutoCommit;
477		procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override;
478		procedure InternalCancel; override;
479		procedure InternalClose; override;
#	Line 375 | Line 491 | type
491		procedure InternalSetFieldData(Field: TField; Buffer: Pointer); virtual;
492		procedure InternalSetToRecord(Buffer: PChar); override;
493		function IsCursorOpen: Boolean; override;
494	+	procedure Loaded; override;
495		procedure ReQuery;
496		procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
497		procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
498		procedure SetCachedUpdates(Value: Boolean);
499		procedure SetDataSource(Value: TDataSource);
500	+	procedure SetGenerateParamNames(AValue: Boolean); virtual;
501		procedure SetFieldData(Field : TField; Buffer : Pointer); override;
502		procedure SetFieldData(Field : TField; Buffer : Pointer;
503		NativeFormat : Boolean); overload; override;
#	Line 387 | Line 505 | type
505
506		protected
507		{Likely to be made public by descendant classes}
508	+	property AutoCommit: TIBAutoCommit read FAutoCommit write FAutoCommit default acDisabled;
509		property SQLParams: TIBXSQLDA read GetSQLParams;
510		property Params: TIBXSQLDA read GetSQLParams;
511		property InternalPrepared: Boolean read FInternalPrepared;
#	Line 402 | Line 521 | type
521		property BufferChunks: Integer read FBufferChunks write SetBufferChunks;
522		property CachedUpdates: Boolean read FCachedUpdates write SetCachedUpdates;
523		property UniDirectional: Boolean read FUniDirectional write SetUniDirectional default False;
524	<	property Generator: TIBGenerator read FGenerator write FGenerator;
524	>	property GeneratorField: TIBGenerator read FGeneratorField write FGeneratorField;
525		property DeleteSQL: TStrings read GetDeleteSQL write SetDeleteSQL;
526		property InsertSQL: TStrings read GetInsertSQL write SetInsertSQL;
527		property RefreshSQL: TStrings read GetRefreshSQL write SetRefreshSQL;
#	Line 410 | Line 529 | type
529		property ModifySQL: TStrings read GetModifySQL write SetModifySQL;
530		property UpdateMode: TUpdateMode read FUpdateMode write SetUpdateMode default upWhereAll;
531		property ParamCheck: Boolean read FParamCheck write FParamCheck default True;
532	+	property Parser: TSelectSQLParser read GetParser;
533	+	property BaseSQLSelect: TStrings read FBaseSQLSelect;
534
535		property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect
536		write FBeforeDatabaseDisconnect;
#	Line 423 | Line 544 | type
544		write FAfterTransactionEnd;
545		property TransactionFree: TNotifyEvent read FTransactionFree
546		write FTransactionFree;
547	+	property OnValidatePost: TOnValidatePost read FOnValidatePost write FOnValidatePost;
548
549		public
550		constructor Create(AOwner: TComponent); override;
#	Line 430 | Line 552 | type
552		procedure ApplyUpdates;
553		function CachedUpdateStatus: TCachedUpdateStatus;
554		procedure CancelUpdates;
555	+	function GetFieldPosition(AliasName: string): integer;
556		procedure FetchAll;
557		function LocateNext(const KeyFields: string; const KeyValues: Variant;
558		Options: TLocateOptions): Boolean;
559		procedure RecordModified(Value: Boolean);
560		procedure RevertRecord;
561		procedure Undelete;
562	+	procedure ResetParser; virtual;
563	+	function HasParser: boolean;
564
565		{ TDataSet support methods }
566		function BookmarkValid(Bookmark: TBookmark): Boolean; override;
#	Line 446 | Line 571 | type
571		function GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; overload; (*override;*)
572		function GetFieldData(Field : TField; Buffer : Pointer;
573		NativeFormat : Boolean) : Boolean; overload; override;
574	+	property GenerateParamNames: Boolean read FGenerateParamNames write SetGenerateParamNames;
575		function Locate(const KeyFields: string; const KeyValues: Variant;
576		Options: TLocateOptions): Boolean; override;
577		function Lookup(const KeyFields: string; const KeyValues: Variant;
578		const ResultFields: string): Variant; override;
579		function UpdateStatus: TUpdateStatus; override;
580		function IsSequenced: Boolean; override;
581	<
581	>	procedure Post; override;
582	>	function ParamByName(ParamName: String): TIBXSQLVAR;
583		property DBHandle: PISC_DB_HANDLE read GetDBHandle;
584		property TRHandle: PISC_TR_HANDLE read GetTRHandle;
585		property UpdateObject: TIBDataSetUpdateObject read FUpdateObject write SetUpdateObject;
586		property UpdatesPending: Boolean read FUpdatesPending;
587		property UpdateRecordTypes: TIBUpdateRecordTypes read FUpdateRecordTypes
588		write SetUpdateRecordTypes;
589	+	property DataSetCloseAction: TDataSetCloseAction
590	+	read FDataSetCloseAction write FDataSetCloseAction;
591
592		published
593		property Database: TIBDatabase read GetDatabase write SetDatabase;
#	Line 497 | Line 626 | type
626		write FOnUpdateRecord;
627		end;
628
629	<	TIBDataSet = class(TIBCustomDataSet)
629	>	TIBParserDataSet = class(TIBCustomDataSet)
630	>	public
631	>	property Parser;
632	>	end;
633	>
634	>	TIBDataSet = class(TIBParserDataSet)
635		private
636		function GetPrepared: Boolean;
637
#	Line 522 | Line 656 | type
656		property QModify;
657		property StatementType;
658		property SelectStmtHandle;
659	+	property BaseSQLSelect;
660
661		published
662		{ TIBCustomDataSet }
663	+	property AutoCommit;
664		property BufferChunks;
665		property CachedUpdates;
666		property DeleteSQL;
#	Line 532 | Line 668 | type
668		property RefreshSQL;
669		property SelectSQL;
670		property ModifySQL;
671	<	property Generator;
671	>	property GeneratorField;
672	>	property GenerateParamNames;
673		property ParamCheck;
674		property UniDirectional;
675		property Filtered;
676	+	property DataSetCloseAction;
677
678		property BeforeDatabaseDisconnect;
679		property AfterDatabaseDisconnect;
#	Line 571 | Line 709 | type
709		property OnFilterRecord;
710		property OnNewRecord;
711		property OnPostError;
712	+	property OnValidatePost;
713		end;
714
715		{ TIBDSBlobStream }
716		TIBDSBlobStream = class(TStream)
717	+	private
718	+	FHasWritten: boolean;
719		protected
720		FField: TField;
721		FBlobStream: TIBBlobStream;
722		public
723		constructor Create(AField: TField; ABlobStream: TIBBlobStream;
724		Mode: TBlobStreamMode);
725	+	destructor Destroy; override;
726		function Read(var Buffer; Count: Longint): Longint; override;
727		function Seek(Offset: Longint; Origin: Word): Longint; override;
728		procedure SetSize(NewSize: Longint); override;
#	Line 605 | Line 747 | DefaultFieldClasses: array[TFieldType] o
747		TVarBytesField,     { ftVarBytes }
748		TAutoIncField,      { ftAutoInc }
749		TBlobField,         { ftBlob }
750	<	TMemoField,         { ftMemo }
750	>	TIBMemoField,       { ftMemo }
751		TGraphicField,      { ftGraphic }
752		TBlobField,         { ftFmtMemo }
753		TBlobField,         { ftParadoxOle }
#	Line 613 | Line 755 | DefaultFieldClasses: array[TFieldType] o
755		TBlobField,         { ftTypedBinary }
756		nil,                { ftCursor }
757		TStringField,       { ftFixedChar }
758	<	TWideStringField,    { ftWideString }
758	>	TIBWideStringField,    { ftWideString }
759		TLargeIntField,     { ftLargeInt }
760		nil,          { ftADT }
761		nil,        { ftArray }
#	Line 628 | Line 770 | DefaultFieldClasses: array[TFieldType] o
770		TDateTimeField,    {ftTimestamp}
771		TIBBCDField,       {ftFMTBcd}
772		nil,  {ftFixedWideChar}
773	<	TWideMemoField);   {ftWideMemo}
774	<
775	<	(*    TADTField,          { ftADT }
773	>	TIBWideMemoField);   {ftWideMemo}
774	>	(*
775	>	TADTField,          { ftADT }
776		TArrayField,        { ftArray }
777		TReferenceField,    { ftReference }
778		TDataSetField,     { ftDataSet }
#	Line 639 | Line 781 | DefaultFieldClasses: array[TFieldType] o
781		TVariantField,      { ftVariant }
782		TInterfaceField,    { ftInterface }
783		TIDispatchField,     { ftIDispatch }
784	<	TGuidField);        { ftGuid }*)
784	>	TGuidField);        { ftGuid } *)
785		(*var
786		CreateProviderProc: function(DataSet: TIBCustomDataSet): IProvider = nil;*)
787
788		implementation
789
790	<	uses IBIntf, Variants, FmtBCD;
790	>	uses IBIntf, Variants, FmtBCD, LCLProc, LazUTF8;
791
792		const FILE_BEGIN = 0;
793		FILE_CURRENT = 1;
#	Line 668 | Line 810 | type
810		NextRelation : TRelationNode;
811		end;
812
813	+	{Extended Field Def for character set info}
814
815	<	{ TIBStringField}
815	>	{ TIBFieldDef }
816
817	<	constructor TIBStringField.Create(AOwner: TComponent);
817	>	TIBFieldDef = class(TFieldDef)
818	>	private
819	>	FCharacterSetName: string;
820	>	FCharacterSetSize: integer;
821	>	published
822	>	property CharacterSetName: string read FCharacterSetName write FCharacterSetName;
823	>	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
824	>	end;
825	>
826	>	{ TIBWideMemoField }
827	>
828	>	function TIBWideMemoField.GetTruncatedText: string;
829	>	begin
830	>	Result := GetAsString;
831	>
832	>	if Result <> '' then
833	>	if DisplayWidth = 0 then
834	>	Result := TextToSingleLine(Result)
835	>	else
836	>	if Length(Result) > DisplayWidth then {Show truncation with elipses}
837	>	Result := TextToSingleLine(system.copy(Result,1,DisplayWidth-3)) + '...';
838	>	end;
839	>
840	>	function TIBWideMemoField.GetDefaultWidth: Longint;
841	>	begin
842	>	Result := 128;
843	>	end;
844	>
845	>	procedure TIBWideMemoField.GetText(var AText: string; ADisplayText: Boolean);
846	>	begin
847	>	if ADisplayText then
848	>	begin
849	>	if not DisplayTextAsClassName then
850	>	AText := GetTruncatedText
851	>	else
852	>	inherited GetText(AText, ADisplayText);
853	>	end
854	>	else
855	>	AText := GetAsString;
856	>	end;
857	>
858	>	constructor TIBWideMemoField.Create(AOwner: TComponent);
859		begin
860		inherited Create(AOwner);
861	+	BlobType := ftWideMemo;
862	+	end;
863	+
864	+	{ TIBMemoField }
865	+
866	+	function TIBMemoField.GetTruncatedText: string;
867	+	begin
868	+	Result := GetAsString;
869	+
870	+	if Result <> '' then
871	+	begin
872	+	case CharacterSetSize of
873	+	1:
874	+	if DisplayWidth = 0 then
875	+	Result := TextToSingleLine(Result)
876	+	else
877	+	if Length(Result) > DisplayWidth then {Show truncation with elipses}
878	+	Result := TextToSingleLine(system.copy(Result,1,DisplayWidth-3)) + '...';
879	+
880	+	{2: case 2 ignored. This should be handled by TIBWideMemo}
881	+
882	+	3, {Assume UNICODE_FSS is really UTF8}
883	+	4: {Include GB18030 - assuming UTF8 routine work for this codeset}
884	+	if DisplayWidth = 0 then
885	+	Result := ValidUTF8String(TextToSingleLine(Result))
886	+	else
887	+	if UTF8Length(Result) > DisplayWidth then {Show truncation with elipses}
888	+	Result := ValidUTF8String(TextToSingleLine(UTF8Copy(Result,1,DisplayWidth-3))) + '...';
889	+	end;
890	+	end
891	+	end;
892	+
893	+	function TIBMemoField.GetDefaultWidth: Longint;
894	+	begin
895	+	Result := 128;
896	+	end;
897	+
898	+	procedure TIBMemoField.GetText(var AText: string; ADisplayText: Boolean);
899	+	begin
900	+	if ADisplayText then
901	+	begin
902	+	if not DisplayTextAsClassName then
903	+	AText := GetTruncatedText
904	+	else
905	+	inherited GetText(AText, ADisplayText);
906	+	end
907	+	else
908	+	AText := GetAsString;
909	+	end;
910	+
911	+	constructor TIBMemoField.Create(AOwner: TComponent);
912	+	begin
913	+	inherited Create(AOwner);
914	+	BlobType := ftMemo;
915	+	end;
916	+
917	+	{ TIBControlLink }
918	+
919	+	destructor TIBControlLink.Destroy;
920	+	begin
921	+	IBDataSet := nil;
922	+	inherited Destroy;
923	+	end;
924	+
925	+	procedure TIBControlLink.UpdateParams(Sender: TObject);
926	+	begin
927	+
928	+	end;
929	+
930	+	procedure TIBControlLink.UpdateSQL(Sender: TObject);
931	+	begin
932	+
933	+	end;
934	+
935	+	procedure TIBControlLink.SetIBDataSet(AValue: TIBCustomDataSet);
936	+	begin
937	+	if FTIBDataSet = AValue then Exit;
938	+	if IBDataSet <> nil then
939	+	IBDataSet.UnRegisterIBLink(self);
940	+	FTIBDataSet := AValue;
941	+	if IBDataSet <> nil then
942	+	IBDataSet.RegisterIBLink(self);
943	+	end;
944	+
945	+
946	+	{ TIBStringField}
947	+
948	+	function TIBStringField.GetDefaultWidth: Longint;
949	+	begin
950	+	Result := Size div CharacterSetSize;
951	+	end;
952	+
953	+	constructor TIBStringField.Create(aOwner: TComponent);
954	+	begin
955	+	inherited Create(aOwner);
956	+	FCharacterSetSize := 1;
957		end;
958
959		class procedure TIBStringField.CheckTypeSize(Value: Integer);
#	Line 728 | Line 1008 | begin
1008		end;
1009		end;
1010
1011	+
1012		{ TIBBCDField }
1013
1014		constructor TIBBCDField.Create(AOwner: TComponent);
#	Line 770 | Line 1051 | end;
1051
1052		function TIBBCDField.GetDataSize: Integer;
1053		begin
1054	+	{$IFDEF TBCDFIELD_IS_BCD}
1055		Result := 8;
1056	+	{$ELSE}
1057	+	Result := inherited GetDataSize
1058	+	{$ENDIF}
1059		end;
1060
1061		{ TIBDataLink }
#	Line 821 | Line 1106 | begin
1106		CheckIBLoaded;
1107		FIBLoaded := True;
1108		FBase := TIBBase.Create(Self);
1109	+	FIBLinks := TList.Create;
1110		FCurrentRecord := -1;
1111		FDeletedRecords := 0;
1112		FUniDirectional := False;
1113		FBufferChunks := BufferCacheSize;
1114		FBlobStreamList := TList.Create;
1115	<	FGenerator := TIBGenerator.Create(self);
1115	>	FGeneratorField := TIBGenerator.Create(self);
1116		FDataLink := TIBDataLink.Create(Self);
1117		FQDelete := TIBSQL.Create(Self);
1118		FQDelete.OnSQLChanging := SQLChanging;
#	Line 839 | Line 1125 | begin
1125		FQRefresh.GoToFirstRecordOnExecute := False;
1126		FQSelect := TIBSQL.Create(Self);
1127		FQSelect.OnSQLChanging := SQLChanging;
1128	+	FQSelect.OnSQLChanged := SQLChanged;
1129		FQSelect.GoToFirstRecordOnExecute := False;
1130		FQModify := TIBSQL.Create(Self);
1131		FQModify.OnSQLChanging := SQLChanging;
1132		FQModify.GoToFirstRecordOnExecute := False;
1133		FUpdateRecordTypes := [cusUnmodified, cusModified, cusInserted];
1134		FParamCheck := True;
1135	+	FGenerateParamNames := False;
1136		FForcedRefresh := False;
1137	+	FAutoCommit:= acDisabled;
1138	+	FDataSetCloseAction := dcDiscardChanges;
1139		{Bookmark Size is Integer for IBX}
1140		BookmarkSize := SizeOf(Integer);
1141		FBase.BeforeDatabaseDisconnect := DoBeforeDatabaseDisconnect;
#	Line 859 | Line 1149 | begin
1149		else
1150		if AOwner is TIBTransaction then
1151		Transaction := TIBTransaction(AOwner);
1152	+	FBaseSQLSelect := TStringList.Create;
1153		end;
1154
1155		destructor TIBCustomDataSet.Destroy;
1156		begin
1157	+	if Active then Active := false;
1158		if FIBLoaded then
1159		begin
1160	<	if assigned(FGenerator) then FGenerator.Free;
1160	>	if assigned(FGeneratorField) then FGeneratorField.Free;
1161		FDataLink.Free;
1162		FBase.Free;
1163		ClearBlobCache;
1164	+	ClearIBLinks;
1165	+	FIBLinks.Free;
1166		FBlobStreamList.Free;
1167		FreeMem(FBufferCache);
1168		FBufferCache := nil;
#	Line 878 | Line 1172 | begin
1172		FOldCacheSize := 0;
1173		FMappedFieldPosition := nil;
1174		end;
1175	+	if assigned(FBaseSQLSelect) then FBaseSQLSelect.Free;
1176	+	if assigned(FParser) then FParser.Free;
1177		inherited Destroy;
1178		end;
1179
#	Line 919 | Line 1215 | end;
1215
1216		procedure TIBCustomDataSet.ApplyUpdates;
1217		var
1218	+	{$IF FPC_FULLVERSION >= 20700 }
1219	+	CurBookmark: TBookmark;
1220	+	{$ELSE}
1221		CurBookmark: string;
1222	+	{$ENDIF}
1223		Buffer: PRecordData;
1224		CurUpdateTypes: TIBUpdateRecordTypes;
1225		UpdateAction: TIBUpdateAction;
#	Line 979 | Line 1279 | var
1279		procedure UpdateUsingUpdateObject;
1280		begin
1281		try
1282	<	FUpdateObject.Apply(UpdateKind);
1282	>	FUpdateObject.Apply(UpdateKind,PChar(Buffer));
1283		ResetBufferUpdateStatus;
1284		except
1285		on E: Exception do
#	Line 1117 | Line 1417 | begin
1417		end;
1418		end;
1419
1420	+	function TIBCustomDataSet.GetFieldPosition(AliasName: string): integer;
1421	+	var i: integer;
1422	+	Prepared: boolean;
1423	+	begin
1424	+	Result := 0;
1425	+	Prepared := FInternalPrepared;
1426	+	if not Prepared then
1427	+	InternalPrepare;
1428	+	try
1429	+	for i := 0 to Length(FAliasNameList) - 1 do
1430	+	if FAliasNameList[i] = AliasName then
1431	+	begin
1432	+	Result := i + 1;
1433	+	Exit
1434	+	end;
1435	+	finally
1436	+	if not Prepared then
1437	+	InternalUnPrepare;
1438	+	end;
1439	+	end;
1440	+
1441		procedure TIBCustomDataSet.ActivateConnection;
1442		begin
1443		if not Assigned(Database) then
#	Line 1177 | Line 1498 | begin
1498		IBError(ibxeDatasetClosed, [nil]);
1499		end;
1500
1501	+	function TIBCustomDataSet.CreateParser: TSelectSQLParser;
1502	+	begin
1503	+	Result := TSelectSQLParser.Create(self,FBaseSQLSelect);
1504	+	Result.OnSQLChanging := SQLChanging
1505	+	end;
1506	+
1507		procedure TIBCustomDataSet.CheckNotUniDirectional;
1508		begin
1509		if UniDirectional then
#	Line 1280 | Line 1607 | begin
1607		FDatabaseFree(Sender);
1608		end;
1609
1610	<	procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject);
1610	>	procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject;
1611	>	Action: TTransactionAction);
1612		begin
1613	<	if Active then
1614	<	Active := False;
1613	>	FCloseAction := Action;
1614	>	FInTransactionEnd := true;
1615	>	try
1616	>	if Active then
1617	>	Active := False;
1618	>	finally
1619	>	FInTransactionEnd := false;
1620	>	end;
1621		if FQSelect <> nil then
1622		FQSelect.FreeHandle;
1623		if FQDelete <> nil then
#	Line 1321 | Line 1655 | var
1655		LocalData: Pointer;
1656		LocalDate, LocalDouble: Double;
1657		LocalInt: Integer;
1658	+	LocalBool: wordBool;
1659		LocalInt64: Int64;
1660		LocalCurrency: Currency;
1661		FieldsLoaded: Integer;
#	Line 1465 | Line 1800 | begin
1800		end;
1801		end;
1802		end;
1803	+	SQL_BOOLEAN:
1804	+	begin
1805	+	LocalBool:= false;
1806	+	rdFields[j].fdDataSize := SizeOf(wordBool);
1807	+	if RecordNumber >= 0 then
1808	+	LocalBool := Qry.Current[i].AsBoolean;
1809	+	LocalData := PChar(@LocalBool);
1810	+	end;
1811		else { SQL_TEXT, SQL_BLOB, SQL_ARRAY, SQL_QUAD }
1812		begin
1813		rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
#	Line 1589 | Line 1932 | end;
1932		procedure TIBCustomDataSet.InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer);
1933		begin
1934		if (Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukDelete).Text <> '')) then
1935	<	FUpdateObject.Apply(ukDelete)
1935	>	FUpdateObject.Apply(ukDelete,Buff)
1936		else
1937		begin
1938		SetInternalSQLParams(FQDelete, Buff);
#	Line 1606 | Line 1949 | end;
1949		function TIBCustomDataSet.InternalLocate(const KeyFields: string;
1950		const KeyValues: Variant; Options: TLocateOptions): Boolean;
1951		var
1952	<	fl: TList;
1952	>	keyFieldList: TList;
1953	>	{$IF FPC_FULLVERSION >= 20700 }
1954	>	CurBookmark: TBookmark;
1955	>	{$ELSE}
1956		CurBookmark: string;
1957	<	fld, val: Variant;
1958	<	i, fld_cnt: Integer;
1957	>	{$ENDIF}
1958	>	fieldValue: Variant;
1959	>	lookupValues: array of variant;
1960	>	i, fieldCount: Integer;
1961	>	fieldValueAsString: string;
1962	>	lookupValueAsString: string;
1963		begin
1964	<	fl := TList.Create;
1964	>	keyFieldList := TList.Create;
1965		try
1966	<	GetFieldList(fl, KeyFields);
1967	<	fld_cnt := fl.Count;
1966	>	GetFieldList(keyFieldList, KeyFields);
1967	>	fieldCount := keyFieldList.Count;
1968		CurBookmark := Bookmark;
1969	<	result := False;
1970	<	while ((not result) and (not EOF)) do
1969	>	result := false;
1970	>	SetLength(lookupValues, fieldCount);
1971	>	if not EOF then
1972		begin
1973	<	i := 0;
1623	<	result := True;
1624	<	while (result and (i < fld_cnt)) do
1973	>	for i := 0 to fieldCount - 1 do  {expand key values into lookupValues array}
1974		begin
1975	<	if fld_cnt > 1 then
1976	<	val := KeyValues[i]
1975	>	if VarIsArray(KeyValues) then
1976	>	lookupValues[i] := KeyValues[i]
1977	>	else
1978	>	if i > 0 then
1979	>	lookupValues[i] := NULL
1980		else
1981	<	val := KeyValues;
1982	<	fld := TField(fl[i]).Value;
1983	<	result := not (VarIsNull(val) xor VarIsNull(fld));
1984	<	if result and not VarIsNull(val) then
1981	>	lookupValues[0] := KeyValues;
1982	>
1983	>	{convert to upper case is case insensitive search}
1984	>	if (TField(keyFieldList[i]).DataType = ftString) and
1985	>	not VarIsNull(lookupValues[i]) and (loCaseInsensitive in Options) then
1986	>	lookupValues[i] := UpperCase(lookupValues[i]);
1987	>	end;
1988	>	end;
1989	>	while not result and not EOF do   {search for a matching record}
1990	>	begin
1991	>	i := 0;
1992	>	result := true;
1993	>	while result and (i < fieldCount) do
1994	>	{see if all of the key fields matches}
1995	>	begin
1996	>	fieldValue := TField(keyFieldList[i]).Value;
1997	>	result := not (VarIsNull(fieldValue) xor VarIsNull(lookupValues[i]));
1998	>	if result and not VarIsNull(fieldValue) then
1999		begin
2000		try
2001	<	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
2001	>	if TField(keyFieldList[i]).DataType = ftString then
2002		begin
2003	+	{strings need special handling because of the locate options that
2004	+	apply to them}
2005	+	fieldValueAsString := TField(keyFieldList[i]).AsString;
2006	+	lookupValueAsString := lookupValues[i];
2007		if (loCaseInsensitive in Options) then
2008	<	begin
2009	<	fld := AnsiUpperCase(fld);
1645	<	val := AnsiUpperCase(val);
1646	<	end;
1647	<	fld := TrimRight(fld);
1648	<	val := TrimRight(val);
2008	>	fieldValueAsString := UpperCase(fieldValueAsString);
2009	>
2010		if (loPartialKey in Options) then
2011	<	result := result and (AnsiPos(val, fld) = 1)
2011	>	result := result and (Pos(lookupValueAsString, fieldValueAsString) = 1)
2012		else
2013	<	result := result and (val = fld);
2014	<	end else
2015	<	result := result and (val = fld);
2013	>	result := result and (fieldValueAsString = lookupValueAsString);
2014	>	end
2015	>	else
2016	>	result := result and (lookupValues[i] =
2017	>	VarAsType(fieldValue, VarType(lookupValues[i])));
2018	>	except on EVariantError do
2019	>	result := False;
2020	>	end;
2021		end;
2022		Inc(i);
2023		end;
2024		if not result then
2025	<	Next;
2025	>	Next;
2026		end;
2027		if not result then
2028		Bookmark := CurBookmark
2029		else
2030		CursorPosChanged;
2031		finally
2032	<	fl.Free;
2032	>	keyFieldList.Free;
2033	>	SetLength(lookupValues,0)
2034		end;
2035		end;
2036
#	Line 1691 | Line 2058 | begin
2058		if Assigned(FUpdateObject) then
2059		begin
2060		if (Qry = FQDelete) then
2061	<	FUpdateObject.Apply(ukDelete)
2061	>	FUpdateObject.Apply(ukDelete,Buff)
2062		else if (Qry = FQInsert) then
2063	<	FUpdateObject.Apply(ukInsert)
2063	>	FUpdateObject.Apply(ukInsert,Buff)
2064		else
2065	<	FUpdateObject.Apply(ukModify);
2065	>	FUpdateObject.Apply(ukModify,Buff);
2066		end
2067		else begin
2068		SetInternalSQLParams(Qry, Buff);
#	Line 1712 | Line 2079 | end;
2079		procedure TIBCustomDataSet.InternalRefreshRow;
2080		var
2081		Buff: PChar;
1715	–	SetCursor: Boolean;
2082		ofs: DWORD;
2083		Qry: TIBSQL;
2084		begin
2085	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1720	<	if SetCursor then
1721	<	Screen.Cursor := crHourGlass;
2085	>	FBase.SetCursor;
2086		try
2087		Buff := GetActiveBuf;
2088		if CanRefresh then
#	Line 1762 | Line 2126 | begin
2126		else
2127		IBError(ibxeCannotRefresh, [nil]);
2128		finally
2129	<	if SetCursor and (Screen.Cursor = crHourGlass) then
1766	<	Screen.Cursor := crDefault;
2129	>	FBase.RestoreCursor;
2130		end;
2131		end;
2132
#	Line 1834 | Line 2197 | end;
2197
2198		procedure TIBCustomDataSet.InternalPrepare;
2199		var
1837	–	SetCursor: Boolean;
2200		DidActivate: Boolean;
2201		begin
2202		if FInternalPrepared then
2203		Exit;
2204		DidActivate := False;
2205	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1844	<	if SetCursor then
1845	<	Screen.Cursor := crHourGlass;
2205	>	FBase.SetCursor;
2206		try
2207		ActivateConnection;
2208		DidActivate := ActivateTransaction;
2209		FBase.CheckDatabase;
2210		FBase.CheckTransaction;
2211	+	if HasParser and (FParser.SQLText <> FQSelect.SQL.Text) then
2212	+	begin
2213	+	FQSelect.OnSQLChanged := nil; {Do not react to change}
2214	+	try
2215	+	FQSelect.SQL.Text := FParser.SQLText;
2216	+	finally
2217	+	FQSelect.OnSQLChanged := SQLChanged;
2218	+	end;
2219	+	end;
2220	+	//   writeln( FQSelect.SQL.Text);
2221		if FQSelect.SQL.Text <> '' then
2222		begin
2223		if not FQSelect.Prepared then
2224		begin
2225	+	FQSelect.GenerateParamNames := FGenerateParamNames;
2226		FQSelect.ParamCheck := ParamCheck;
2227		FQSelect.Prepare;
2228		end;
2229	<	if (FQDelete.SQL.Text <> '') and (not FQDelete.Prepared) then
2229	>	FQDelete.GenerateParamNames := FGenerateParamNames;
2230	>	if (Trim(FQDelete.SQL.Text) <> '') and (not FQDelete.Prepared) then
2231		FQDelete.Prepare;
2232	<	if (FQInsert.SQL.Text <> '') and (not FQInsert.Prepared) then
2232	>	FQInsert.GenerateParamNames := FGenerateParamNames;
2233	>	if (Trim(FQInsert.SQL.Text) <> '') and (not FQInsert.Prepared) then
2234		FQInsert.Prepare;
2235	<	if (FQRefresh.SQL.Text <> '') and (not FQRefresh.Prepared) then
2235	>	FQRefresh.GenerateParamNames := FGenerateParamNames;
2236	>	if (Trim(FQRefresh.SQL.Text) <> '') and (not FQRefresh.Prepared) then
2237		FQRefresh.Prepare;
2238	<	if (FQModify.SQL.Text <> '') and (not FQModify.Prepared) then
2238	>	FQModify.GenerateParamNames := FGenerateParamNames;
2239	>	if (Trim(FQModify.SQL.Text) <> '') and (not FQModify.Prepared) then
2240		FQModify.Prepare;
2241		FInternalPrepared := True;
2242		InternalInitFieldDefs;
#	Line 1870 | Line 2245 | begin
2245		finally
2246		if DidActivate then
2247		DeactivateTransaction;
2248	<	if SetCursor and (Screen.Cursor = crHourGlass) then
1874	<	Screen.Cursor := crDefault;
2248	>	FBase.RestoreCursor;
2249		end;
2250		end;
2251
#	Line 2061 | Line 2435 | begin
2435		end;
2436		SQL_TIMESTAMP:
2437		Qry.Params[i].AsDateTime :=
2438	<	TimeStampToDateTime(
2439	<	MSecsToTimeStamp(PDouble(data)^));
2438	>	TimeStampToDateTime(MSecsToTimeStamp(trunc(PDouble(data)^)));
2439	>	SQL_BOOLEAN:
2440	>	Qry.Params[i].AsBoolean := PWordBool(data)^;
2441		end;
2442		end;
2443		end;
#	Line 2148 | Line 2523 | begin
2523		end;
2524		end;
2525
2526	+	procedure TIBCustomDataSet.RegisterIBLink(Sender: TIBControlLink);
2527	+	begin
2528	+	if FIBLinks.IndexOf(Sender) = -1 then
2529	+	FIBLinks.Add(Sender);
2530	+	end;
2531	+
2532
2533		procedure TIBCustomDataSet.SQLChanging(Sender: TObject);
2534		begin
2535	<	if FOpen then
2536	<	InternalClose;
2535	>	Active := false;
2536	>	{  if FOpen then
2537	>	InternalClose;}
2538		if FInternalPrepared then
2539		InternalUnPrepare;
2540	+	FieldDefs.Clear;
2541	+	FieldDefs.Updated := false;
2542	+	end;
2543	+
2544	+	procedure TIBCustomDataSet.SQLChanged(Sender: TObject);
2545	+	begin
2546	+	FBaseSQLSelect.assign(FQSelect.SQL);
2547		end;
2548
2549		{ I can "undelete" uninserted records (make them "inserted" again).
#	Line 2183 | Line 2572 | begin
2572		end;
2573		end;
2574
2575	+	procedure TIBCustomDataSet.UnRegisterIBLink(Sender: TIBControlLink);
2576	+	begin
2577	+	FIBLinks.Remove(Sender);
2578	+	end;
2579	+
2580		function TIBCustomDataSet.UpdateStatus: TUpdateStatus;
2581		begin
2582		if Active then
#	Line 2199 | Line 2593 | begin
2593		Result := Assigned( FQSelect ) and FQSelect.EOF;
2594		end;
2595
2596	+	function TIBCustomDataSet.ParamByName(ParamName: String): TIBXSQLVAR;
2597	+	begin
2598	+	ActivateConnection;
2599	+	ActivateTransaction;
2600	+	if not FInternalPrepared then
2601	+	InternalPrepare;
2602	+	Result := Params.ByName(ParamName);
2603	+	end;
2604	+
2605	+	{Beware: the parameter FCache is used as an identifier to determine which
2606	+	cache is being operated on and is not referenced in the computation.
2607	+	The result is an adjusted offset into the identified cache, either the
2608	+	Buffer Cache or the old Buffer Cache.}
2609	+
2610		function TIBCustomDataSet.AdjustPosition(FCache: PChar; Offset: DWORD;
2611	<	Origin: Integer): Integer;
2611	>	Origin: Integer): DWORD;
2612		var
2613		OldCacheSize: Integer;
2614		begin
#	Line 2237 | Line 2645 | procedure TIBCustomDataSet.ReadCache(FCa
2645		Buffer: PChar);
2646		var
2647		pCache: PChar;
2648	+	AdjustedOffset: DWORD;
2649		bOld: Boolean;
2650		begin
2651		bOld := (FCache = FOldBufferCache);
2652	<	pCache := PChar(AdjustPosition(FCache, Offset, Origin));
2652	>	AdjustedOffset := AdjustPosition(FCache, Offset, Origin);
2653		if not bOld then
2654	<	pCache := FBufferCache + Integer(pCache)
2654	>	pCache := FBufferCache + AdjustedOffset
2655		else
2656	<	pCache := FOldBufferCache + Integer(pCache);
2656	>	pCache := FOldBufferCache + AdjustedOffset;
2657		Move(pCache^, Buffer^, DWORD(FRecordBufferSize));
2658		AdjustPosition(FCache, FRecordBufferSize, FILE_CURRENT);
2659		end;
#	Line 2274 | Line 2683 | procedure TIBCustomDataSet.WriteCache(FC
2683		Buffer: PChar);
2684		var
2685		pCache: PChar;
2686	+	AdjustedOffset: DWORD;
2687		bOld: Boolean;
2688		dwEnd: DWORD;
2689		begin
2690		bOld := (FCache = FOldBufferCache);
2691	<	pCache := PChar(AdjustPosition(FCache, Offset, Origin));
2691	>	AdjustedOffset := AdjustPosition(FCache, Offset, Origin);
2692		if not bOld then
2693	<	pCache := FBufferCache + Integer(pCache)
2693	>	pCache := FBufferCache + AdjustedOffset
2694		else
2695	<	pCache := FOldBufferCache + Integer(pCache);
2695	>	pCache := FOldBufferCache + AdjustedOffset;
2696		Move(Buffer^, pCache^, FRecordBufferSize);
2697		dwEnd := AdjustPosition(FCache, FRecordBufferSize, FILE_CURRENT);
2698		if not bOld then
#	Line 2396 | Line 2806 | begin
2806		inherited DoBeforeDelete;
2807		end;
2808
2809	+	procedure TIBCustomDataSet.DoAfterDelete;
2810	+	begin
2811	+	inherited DoAfterDelete;
2812	+	FBase.DoAfterDelete(self);
2813	+	InternalAutoCommit;
2814	+	end;
2815	+
2816		procedure TIBCustomDataSet.DoBeforeEdit;
2817		var
2818		Buff: PRecordData;
#	Line 2410 | Line 2827 | begin
2827		inherited DoBeforeEdit;
2828		end;
2829
2830	+	procedure TIBCustomDataSet.DoAfterEdit;
2831	+	begin
2832	+	inherited DoAfterEdit;
2833	+	FBase.DoAfterEdit(self);
2834	+	end;
2835	+
2836		procedure TIBCustomDataSet.DoBeforeInsert;
2837		begin
2838		if not CanInsert then
#	Line 2419 | Line 2842 | end;
2842
2843		procedure TIBCustomDataSet.DoAfterInsert;
2844		begin
2845	<	if Generator.ApplyOnEvent = gaeOnNewRecord then
2846	<	Generator.Apply;
2845	>	if GeneratorField.ApplyOnEvent = gaeOnNewRecord then
2846	>	GeneratorField.Apply;
2847		inherited DoAfterInsert;
2848	+	FBase.DoAfterInsert(self);
2849	+	end;
2850	+
2851	+	procedure TIBCustomDataSet.DoBeforeClose;
2852	+	begin
2853	+	inherited DoBeforeClose;
2854	+	if State in [dsInsert,dsEdit] then
2855	+	begin
2856	+	if FInTransactionEnd and (FCloseAction = TARollback) then
2857	+	Exit;
2858	+
2859	+	if DataSetCloseAction = dcSaveChanges then
2860	+	Post;
2861	+	{Note this can fail with an exception e.g. due to
2862	+	database validation error. In which case the dataset remains open }
2863	+	end;
2864	+	end;
2865	+
2866	+	procedure TIBCustomDataSet.DoBeforeOpen;
2867	+	var i: integer;
2868	+	begin
2869	+	if assigned(FParser) then
2870	+	FParser.Reset;
2871	+	for i := 0 to FIBLinks.Count - 1 do
2872	+	TIBControlLink(FIBLinks[i]).UpdateSQL(self);
2873	+	inherited DoBeforeOpen;
2874	+	for i := 0 to FIBLinks.Count - 1 do
2875	+	TIBControlLink(FIBLinks[i]).UpdateParams(self);
2876		end;
2877
2878		procedure TIBCustomDataSet.DoBeforePost;
2879		begin
2880		inherited DoBeforePost;
2881		if (State = dsInsert) and
2882	<	(Generator.ApplyOnEvent = gaeOnPostRecord) then
2883	<	Generator.Apply
2882	>	(GeneratorField.ApplyOnEvent = gaeOnPostRecord) then
2883	>	GeneratorField.Apply
2884	>	end;
2885	>
2886	>	procedure TIBCustomDataSet.DoAfterPost;
2887	>	begin
2888	>	inherited DoAfterPost;
2889	>	FBase.DoAfterPost(self);
2890	>	InternalAutoCommit;
2891		end;
2892
2893		procedure TIBCustomDataSet.FetchAll;
2894		var
2895	<	SetCursor: Boolean;
2895	>	{$IF FPC_FULLVERSION >= 20700 }
2896	>	CurBookmark: TBookmark;
2897	>	{$ELSE}
2898		CurBookmark: string;
2899	+	{$ENDIF}
2900		begin
2901	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
2902	<	if SetCursor then
2442	<	Screen.Cursor := crHourGlass;
2443	<	try
2901	>	FBase.SetCursor;
2902	>	try
2903		if FQSelect.EOF or not FQSelect.Open then
2904		exit;
2905		DisableControls;
#	Line 2452 | Line 2911 | begin
2911		EnableControls;
2912		end;
2913		finally
2914	<	if SetCursor and (Screen.Cursor = crHourGlass) then
2456	<	Screen.Cursor := crDefault;
2914	>	FBase.RestoreCursor;
2915		end;
2916		end;
2917
#	Line 2501 | Line 2959 | begin
2959		result := FDataLink.DataSource;
2960		end;
2961
2962	+	function TIBCustomDataSet.GetDBAliasName(FieldNo: integer): string;
2963	+	begin
2964	+	Result := FAliasNameMap[FieldNo-1]
2965	+	end;
2966	+
2967	+	function TIBCustomDataSet.GetFieldDefFromAlias(aliasName: string): TFieldDef;
2968	+	var
2969	+	i: integer;
2970	+	begin
2971	+	Result := nil;
2972	+	for i := 0 to Length(FAliasNameMap) - 1 do
2973	+	if FAliasNameMap[i] = aliasName then
2974	+	begin
2975	+	Result := FieldDefs[i];
2976	+	Exit
2977	+	end;
2978	+	end;
2979	+
2980		function TIBCustomDataSet.GetFieldClass(FieldType: TFieldType): TFieldClass;
2981		begin
2982		Result := DefaultFieldClasses[FieldType];
#	Line 2519 | Line 2995 | begin
2995		result := False;
2996		Buff := GetActiveBuf;
2997		if (Buff = nil) or
2998	<	(not IsVisible(Buff)) then
2998	>	(not IsVisible(Buff)) or not assigned(Field.DataSet) then
2999		exit;
3000		{ The intention here is to stuff the buffer with the data for the
3001		referenced field for the current record }
#	Line 2541 | Line 3017 | begin
3017		Data := Buff + CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs;
3018		if (fdDataType = SQL_VARYING) or (fdDataType = SQL_TEXT) then
3019		begin
3020	<	Move(Data^, Buffer^, fdDataLength);
3021	<	PChar(Buffer)[fdDataLength] := #0;
3020	>	if fdDataLength < Field.DataSize then
3021	>	begin
3022	>	Move(Data^, Buffer^, fdDataLength);
3023	>	PChar(Buffer)[fdDataLength] := #0;
3024	>	end
3025	>	else
3026	>	IBError(ibxeFieldSizeError,[Field.FieldName])
3027		end
3028		else
3029		Move(Data^, Buffer^, Field.DataSize);
#	Line 2585 | Line 3066 | begin
3066		if not Accept and (GetMode = gmCurrent) then
3067		GetMode := gmPrior;
3068		except
3069	<	//        Application.HandleException(Self);
3069	>	//        FBase.HandleException(Self);
3070		end;
3071		end;
3072		RestoreState(SaveState);
#	Line 2679 | Line 3160 | begin
3160		result := FRecordBufferSize;
3161		end;
3162
3163	+	procedure TIBCustomDataSet.InternalAutoCommit;
3164	+	begin
3165	+	with Transaction do
3166	+	if InTransaction and (FAutoCommit = acCommitRetaining) then
3167	+	begin
3168	+	if CachedUpdates then ApplyUpdates;
3169	+	CommitRetaining;
3170	+	end;
3171	+	end;
3172	+
3173		procedure TIBCustomDataSet.InternalAddRecord(Buffer: Pointer; Append: Boolean);
3174		begin
3175		CheckEditState;
#	Line 2750 | Line 3241 | begin
3241		FreeMem(FOldBufferCache);
3242		FOldBufferCache := nil;
3243		BindFields(False);
3244	+	ResetParser;
3245		if DefaultFields then DestroyFields;
3246		end;
3247
3248		procedure TIBCustomDataSet.InternalDelete;
3249		var
3250		Buff: PChar;
2759	–	SetCursor: Boolean;
3251		begin
3252	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
2762	<	if SetCursor then
2763	<	Screen.Cursor := crHourGlass;
3252	>	FBase.SetCursor;
3253		try
3254		Buff := GetActiveBuf;
3255		if CanDelete then
#	Line 2785 | Line 3274 | begin
3274		end else
3275		IBError(ibxeCannotDelete, [nil]);
3276		finally
3277	<	if SetCursor and (Screen.Cursor = crHourGlass) then
2789	<	Screen.Cursor := crDefault;
3277	>	FBase.RestoreCursor;
3278		end;
3279		end;
3280
#	Line 2802 | Line 3290 | end;
3290
3291		procedure TIBCustomDataSet.InternalHandleException;
3292		begin
3293	<	Application.HandleException(Self)
3293	>	FBase.HandleException(Self)
3294		end;
3295
3296		procedure TIBCustomDataSet.InternalInitFieldDefs;
3297	+	begin
3298	+	if not InternalPrepared then
3299	+	begin
3300	+	InternalPrepare;
3301	+	exit;
3302	+	end;
3303	+	FieldDefsFromQuery(FQSelect);
3304	+	end;
3305	+
3306	+	procedure TIBCustomDataSet.FieldDefsFromQuery(SourceQuery: TIBSQL);
3307		const
3308		DefaultSQL = 'Select F.RDB$COMPUTED_BLR, ' + {do not localize}
3309		'F.RDB$DEFAULT_VALUE, R.RDB$FIELD_NAME ' + {do not localize}
#	Line 2817 | Line 3315 | const
3315		var
3316		FieldType: TFieldType;
3317		FieldSize: Word;
3318	+	charSetID: short;
3319	+	CharSetSize: integer;
3320	+	CharSetName: string;
3321		FieldNullable : Boolean;
3322		i, FieldPosition, FieldPrecision: Integer;
3323	<	FieldAliasName: string;
3323	>	FieldAliasName, DBAliasName: string;
3324		RelationName, FieldName: string;
3325		Query : TIBSQL;
3326		FieldIndex: Integer;
#	Line 2919 | Line 3420 | var
3420		end;
3421
3422		begin
2922	–	if not InternalPrepared then
2923	–	begin
2924	–	InternalPrepare;
2925	–	exit;
2926	–	end;
3423		FRelationNodes := TRelationNode.Create;
3424		FNeedsRefresh := False;
3425		Database.InternalTransaction.StartTransaction;
#	Line 2934 | Line 3430 | begin
3430		FieldDefs.BeginUpdate;
3431		FieldDefs.Clear;
3432		FieldIndex := 0;
3433	<	if (Length(FMappedFieldPosition) < FQSelect.Current.Count) then
3434	<	SetLength(FMappedFieldPosition, FQSelect.Current.Count);
3433	>	if (Length(FMappedFieldPosition) < SourceQuery.Current.Count) then
3434	>	SetLength(FMappedFieldPosition, SourceQuery.Current.Count);
3435		Query.SQL.Text := DefaultSQL;
3436		Query.Prepare;
3437	<	for i := 0 to FQSelect.Current.Count - 1 do
3438	<	with FQSelect.Current[i].Data^ do
3437	>	SetLength(FAliasNameMap, SourceQuery.Current.Count);
3438	>	SetLength(FAliasNameList, SourceQuery.Current.Count);
3439	>	for i := 0 to SourceQuery.Current.Count - 1 do
3440	>	with SourceQuery.Current[i].Data^ do
3441		begin
3442		{ Get the field name }
3443	<	SetString(FieldAliasName, aliasname, aliasname_length);
3443	>	FieldAliasName := SourceQuery.Current[i].Name;
3444	>	SetString(DBAliasName, aliasname, aliasname_length);
3445		SetString(RelationName, relname, relname_length);
3446		SetString(FieldName, sqlname, sqlname_length);
3447	+	FAliasNameList[i] := DBAliasName;
3448		FieldSize := 0;
3449		FieldPrecision := 0;
3450	<	FieldNullable := FQSelect.Current[i].IsNullable;
3450	>	FieldNullable := SourceQuery.Current[i].IsNullable;
3451	>	CharSetSize := 0;
3452	>	CharSetName := '';
3453		case sqltype and not 1 of
3454		{ All VARCHAR's must be converted to strings before recording
3455		their values }
3456		SQL_VARYING, SQL_TEXT:
3457		begin
3458	+	CharSetSize := FBase.GetCharSetSize(sqlsubtype and $FF);
3459	+	CharSetName := FBase.GetCharSetName(sqlsubtype and $FF);
3460	+	{FieldSize is encoded for strings - see TIBStringField.SetSize for decode}
3461		FieldSize := sqllen;
3462	<	FieldType := ftString;
3462	>	if CharSetSize = 2 then
3463	>	FieldType := ftWideString
3464	>	else
3465	>	FieldType := ftString;
3466		end;
3467		{ All Doubles/Floats should be cast to doubles }
3468		SQL_DOUBLE, SQL_FLOAT:
#	Line 2980 | Line 3488 | begin
3488		FieldSize := -sqlscale;
3489		end
3490		else
3491	<	FieldType := ftFloat;
3491	>	if Database.SQLDialect = 1 then
3492	>	FieldType := ftFloat
3493	>	else
3494	>	if (FieldCount > i) and (Fields[i] is TFloatField) then
3495	>	FieldType := ftFloat
3496	>	else
3497	>	begin
3498	>	FieldType := ftFMTBCD;
3499	>	FieldPrecision := 9;
3500	>	FieldSize := -sqlscale;
3501		end;
3502	+	end;
3503	+
3504		SQL_INT64:
3505		begin
3506		if (sqlscale = 0) then
#	Line 2993 | Line 3512 | begin
3512		FieldSize := -sqlscale;
3513		end
3514		else
3515	<	FieldType := ftFloat;
3516	<	end;
3515	>	FieldType := ftFloat
3516	>	end;
3517		SQL_TIMESTAMP: FieldType := ftDateTime;
3518		SQL_TYPE_TIME: FieldType := ftTime;
3519		SQL_TYPE_DATE: FieldType := ftDate;
#	Line 3002 | Line 3521 | begin
3521		begin
3522		FieldSize := sizeof (TISC_QUAD);
3523		if (sqlsubtype = 1) then
3524	<	FieldType := ftmemo
3524	>	begin
3525	>	if strpas(sqlname) = '' then {Complex SQL with no identifiable column - use connection default}
3526	>	begin
3527	>	CharSetSize := FBase.GetDefaultCharSetSize;
3528	>	CharSetName := FBase.GetDefaultCharSetName;
3529	>	end
3530	>	else
3531	>	begin
3532	>	charSetID := GetBlobCharSetID(Database.Handle,Database.InternalTransaction.Handle,
3533	>	@relname,@sqlname);
3534	>	CharSetSize := FBase.GetCharSetSize(charSetID);
3535	>	CharSetName := FBase.GetCharSetName(charSetID);
3536	>	end;
3537	>	if CharSetSize = 2 then
3538	>	FieldType := ftWideMemo
3539	>	else
3540	>	FieldType := ftMemo;
3541	>	end
3542		else
3543		FieldType := ftBlob;
3544		end;
#	Line 3011 | Line 3547 | begin
3547		FieldSize := sizeof (TISC_QUAD);
3548		FieldType := ftUnknown;
3549		end;
3550	+	SQL_BOOLEAN:
3551	+	FieldType:= ftBoolean;
3552		else
3553		FieldType := ftUnknown;
3554		end;
#	Line 3019 | Line 3557 | begin
3557		begin
3558		FMappedFieldPosition[FieldIndex] := FieldPosition;
3559		Inc(FieldIndex);
3560	<	with FieldDefs.AddFieldDef do
3560	>	with TIBFieldDef.Create(FieldDefs,'',FieldType,0,False,FieldDefs.Count+1) do
3561		begin
3562	<	Name := string( FieldAliasName );
3563	<	(*           FieldNo := FieldPosition;*)
3026	<	DataType := FieldType;
3562	>	Name := FieldAliasName;
3563	>	FAliasNameMap[FieldNo-1] := DBAliasName;
3564		Size := FieldSize;
3565		Precision := FieldPrecision;
3566		Required := not FieldNullable;
3567		InternalCalcField := False;
3568	+	CharacterSetSize := CharSetSize;
3569	+	CharacterSetName := CharSetName;
3570		if (FieldName <> '') and (RelationName <> '') then
3571		begin
3572		if Has_COMPUTED_BLR(RelationName, FieldName) then
#	Line 3107 | Line 3646 | begin
3646		else case cur_field.DataType of
3647		ftString:
3648		cur_param.AsString := cur_field.AsString;
3649	<	ftBoolean, ftSmallint, ftWord:
3649	>	ftBoolean:
3650	>	cur_param.AsBoolean := cur_field.AsBoolean;
3651	>	ftSmallint, ftWord:
3652		cur_param.AsShort := cur_field.AsInteger;
3653		ftInteger:
3654		cur_param.AsLong := cur_field.AsInteger;
#	Line 3160 | Line 3701 | begin
3701		end;
3702
3703		procedure TIBCustomDataSet.InternalOpen;
3163	–	var
3164	–	SetCursor: Boolean;
3704
3705		function RecordDataLength(n: Integer): Long;
3706		begin
3707		result := SizeOf(TRecordData) + ((n - 1) * SizeOf(TFieldData));
3708		end;
3709
3710	+	function GetFieldDef(aFieldNo: integer): TIBFieldDef;
3711	+	var i: integer;
3712	+	begin
3713	+	Result := nil;
3714	+	for i := 0 to FieldDefs.Count - 1 do
3715	+	if FieldDefs[i].FieldNo = aFieldNo then
3716	+	begin
3717	+	Result := TIBFieldDef(FieldDefs[i]);
3718	+	break;
3719	+	end;
3720	+	end;
3721	+
3722	+	procedure SetExtendedProperties;
3723	+	var i: integer;
3724	+	IBFieldDef: TIBFieldDef;
3725	+	begin
3726	+	for i := 0 to Fields.Count - 1 do
3727	+	if Fields[i].FieldNo > 0 then
3728	+	begin
3729	+	if(Fields[i] is TIBStringField) then
3730	+	with TIBStringField(Fields[i]) do
3731	+	begin
3732	+	IBFieldDef := GetFieldDef(FieldNo);
3733	+	if IBFieldDef <> nil then
3734	+	begin
3735	+	CharacterSetSize := IBFieldDef.CharacterSetSize;
3736	+	CharacterSetName := IBFieldDef.CharacterSetName;
3737	+	end;
3738	+	end
3739	+	else
3740	+	if(Fields[i] is TIBWideStringField) then
3741	+	with TIBWideStringField(Fields[i]) do
3742	+	begin
3743	+	IBFieldDef := GetFieldDef(FieldNo);
3744	+	if IBFieldDef <> nil then
3745	+	begin
3746	+	CharacterSetSize := IBFieldDef.CharacterSetSize;
3747	+	CharacterSetName := IBFieldDef.CharacterSetName;
3748	+	end;
3749	+	end
3750	+	else
3751	+	if(Fields[i] is TIBMemoField) then
3752	+	with TIBMemoField(Fields[i]) do
3753	+	begin
3754	+	IBFieldDef := GetFieldDef(FieldNo);
3755	+	if IBFieldDef <> nil then
3756	+	begin
3757	+	CharacterSetSize := IBFieldDef.CharacterSetSize;
3758	+	CharacterSetName := IBFieldDef.CharacterSetName;
3759	+	end;
3760	+	end
3761	+	else
3762	+	if(Fields[i] is TIBWideMemoField) then
3763	+	with TIBWideMemoField(Fields[i]) do
3764	+	begin
3765	+	IBFieldDef := GetFieldDef(FieldNo);
3766	+	if IBFieldDef <> nil then
3767	+	begin
3768	+	CharacterSetSize := IBFieldDef.CharacterSetSize;
3769	+	CharacterSetName := IBFieldDef.CharacterSetName;
3770	+	end;
3771	+	end
3772	+	end
3773	+	end;
3774	+
3775		begin
3776	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3173	<	if SetCursor then
3174	<	Screen.Cursor := crHourGlass;
3776	>	FBase.SetCursor;
3777		try
3778		ActivateConnection;
3779		ActivateTransaction;
#	Line 3184 | Line 3786 | begin
3786		if DefaultFields then
3787		CreateFields;
3788		BindFields(True);
3789	+	SetExtendedProperties;
3790		FCurrentRecord := -1;
3791		FQSelect.ExecQuery;
3792		FOpen := FQSelect.Open;
#	Line 3232 | Line 3835 | begin
3835		else
3836		FQSelect.ExecQuery;
3837		finally
3838	<	if SetCursor and (Screen.Cursor = crHourGlass) then
3236	<	Screen.Cursor := crDefault;
3838	>	FBase.RestoreCursor;
3839		end;
3840		end;
3841
#	Line 3241 | Line 3843 | procedure TIBCustomDataSet.InternalPost;
3843		var
3844		Qry: TIBSQL;
3845		Buff: PChar;
3244	–	SetCursor: Boolean;
3846		bInserting: Boolean;
3847		begin
3848	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3248	<	if SetCursor then
3249	<	Screen.Cursor := crHourGlass;
3848	>	FBase.SetCursor;
3849		try
3850		Buff := GetActiveBuf;
3851		CheckEditState;
#	Line 3284 | Line 3883 | begin
3883		if bInserting then
3884		Inc(FRecordCount);
3885		finally
3886	<	if SetCursor and (Screen.Cursor = crHourGlass) then
3288	<	Screen.Cursor := crDefault;
3886	>	FBase.RestoreCursor;
3887		end;
3888		end;
3889
#	Line 3305 | Line 3903 | begin
3903		result := FOpen;
3904		end;
3905
3906	+	procedure TIBCustomDataSet.Loaded;
3907	+	begin
3908	+	if assigned(FQSelect) then
3909	+	FBaseSQLSelect.assign(FQSelect.SQL);
3910	+	inherited Loaded;
3911	+	end;
3912	+
3913	+	procedure TIBCustomDataSet.Post;
3914	+	var CancelPost: boolean;
3915	+	begin
3916	+	CancelPost := false;
3917	+	if assigned(FOnValidatePost) then
3918	+	OnValidatePost(self,CancelPost);
3919	+	if CancelPost then
3920	+	Cancel
3921	+	else
3922	+	inherited Post;
3923	+	end;
3924	+
3925		function TIBCustomDataSet.Locate(const KeyFields: string; const KeyValues: Variant;
3926		Options: TLocateOptions): Boolean;
3927		var
3928	+	{$IF FPC_FULLVERSION >= 20700 }
3929	+	CurBookmark: TBookmark;
3930	+	{$ELSE}
3931		CurBookmark: string;
3932	+	{$ENDIF}
3933		begin
3934		DisableControls;
3935		try
#	Line 3326 | Line 3947 | function TIBCustomDataSet.Lookup(const K
3947		const ResultFields: string): Variant;
3948		var
3949		fl: TList;
3950	+	{$IF FPC_FULLVERSION >= 20700 }
3951	+	CurBookmark: TBookmark;
3952	+	{$ELSE}
3953		CurBookmark: string;
3954	+	{$ENDIF}
3955		begin
3956		DisableControls;
3957		fl := TList.Create;
#	Line 3379 | Line 4004 | end;
4004		procedure TIBCustomDataSet.InternalSetFieldData(Field: TField; Buffer: Pointer);
4005		var
4006		Buff, TmpBuff: PChar;
4007	+	MappedFieldPos: integer;
4008		begin
4009		Buff := GetActiveBuf;
4010		if Field.FieldNo < 0 then
#	Line 3395 | Line 4021 | begin
4021		begin
4022		{ If inserting, Adjust record position }
4023		AdjustRecordOnInsert(Buff);
4024	<	if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and
4025	<	(FMappedFieldPosition[Field.FieldNo - 1] <= rdFieldCount) then
4024	>	MappedFieldPos := FMappedFieldPosition[Field.FieldNo - 1];
4025	>	if (MappedFieldPos > 0) and
4026	>	(MappedFieldPos <= rdFieldCount) then
4027		begin
4028		Field.Validate(Buffer);
4029		if (Buffer = nil) or
4030		(Field is TIBStringField) and (PChar(Buffer)[0] = #0) then
4031	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull := True
4031	>	rdFields[MappedFieldPos].fdIsNull := True
4032		else begin
4033	<	Move(Buffer^, Buff[rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs],
4034	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataSize);
4035	<	if (rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_TEXT) or
4036	<	(rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_VARYING) then
4037	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataLength := StrLen(PChar(Buffer));
4038	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull := False;
4033	>	Move(Buffer^, Buff[rdFields[MappedFieldPos].fdDataOfs],
4034	>	rdFields[MappedFieldPos].fdDataSize);
4035	>	if (rdFields[MappedFieldPos].fdDataType = SQL_TEXT) or
4036	>	(rdFields[MappedFieldPos].fdDataType = SQL_VARYING) then
4037	>	rdFields[MappedFieldPos].fdDataLength := StrLen(PChar(Buffer));
4038	>	rdFields[MappedFieldPos].fdIsNull := False;
4039		if rdUpdateStatus = usUnmodified then
4040		begin
4041		if CachedUpdates then
#	Line 3432 | Line 4059 | begin
4059		end;
4060		end;
4061		if not (State in [dsCalcFields, dsFilter, dsNewValue]) then
4062	<	DataEvent(deFieldChange, Longint(Field));
4062	>	DataEvent(deFieldChange, PtrInt(Field));
4063		end;
4064
4065		procedure TIBCustomDataSet.SetRecNo(Value: Integer);
#	Line 3496 | Line 4123 | begin
4123		FillChar(Buffer[FRecordSize], CalcFieldsSize, 0);
4124		end;
4125
4126	+	procedure TIBCustomDataSet.ClearIBLinks;
4127	+	var i: integer;
4128	+	begin
4129	+	for i := FIBLinks.Count - 1 downto 0 do
4130	+	TIBControlLink(FIBLinks[i]).IBDataSet := nil;
4131	+	end;
4132	+
4133
4134		procedure TIBCustomDataSet.InternalUnPrepare;
4135		begin
#	Line 3503 | Line 4137 | begin
4137		begin
4138		CheckDatasetClosed;
4139		FieldDefs.Clear;
4140	+	FieldDefs.Updated := false;
4141		FInternalPrepared := False;
4142	+	Setlength(FAliasNameList,0);
4143		end;
4144		end;
4145
4146		procedure TIBCustomDataSet.InternalExecQuery;
4147		var
4148		DidActivate: Boolean;
3513	–	SetCursor: Boolean;
4149		begin
4150		DidActivate := False;
4151	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3517	<	if SetCursor then
3518	<	Screen.Cursor := crHourGlass;
4151	>	FBase.SetCursor;
4152		try
4153		ActivateConnection;
4154		DidActivate := ActivateTransaction;
#	Line 3532 | Line 4165 | begin
4165		finally
4166		if DidActivate then
4167		DeactivateTransaction;
4168	<	if SetCursor and (Screen.Cursor = crHourGlass) then
3536	<	Screen.Cursor := crDefault;
4168	>	FBase.RestoreCursor;
4169		end;
4170		end;
4171
#	Line 3542 | Line 4174 | begin
4174		Result := FQSelect.Handle;
4175		end;
4176
4177	+	function TIBCustomDataSet.GetParser: TSelectSQLParser;
4178	+	begin
4179	+	if not assigned(FParser) then
4180	+	FParser := CreateParser;
4181	+	Result := FParser
4182	+	end;
4183	+
4184	+	procedure TIBCustomDataSet.ResetParser;
4185	+	begin
4186	+	if assigned(FParser) then
4187	+	begin
4188	+	FParser.Free;
4189	+	FParser := nil;
4190	+	FQSelect.OnSQLChanged := nil; {Do not react to change}
4191	+	try
4192	+	FQSelect.SQL.Assign(FBaseSQLSelect);
4193	+	finally
4194	+	FQSelect.OnSQLChanged := SQLChanged;
4195	+	end;
4196	+	end;
4197	+	end;
4198	+
4199	+	function TIBCustomDataSet.HasParser: boolean;
4200	+	begin
4201	+	Result := not (csDesigning in ComponentState) and (FParser <> nil)
4202	+	end;
4203	+
4204	+	procedure TIBCustomDataSet.SetGenerateParamNames(AValue: Boolean);
4205	+	begin
4206	+	if FGenerateParamNames = AValue then Exit;
4207	+	FGenerateParamNames := AValue;
4208	+	Disconnect
4209	+	end;
4210	+
4211		procedure TIBCustomDataSet.InitRecord(Buffer: PChar);
4212		begin
4213		inherited InitRecord(Buffer);
#	Line 3788 | Line 4454 | end;
4454
4455		function TIBCustomDataSet.GetFieldData(Field: TField;
4456		Buffer: Pointer): Boolean;
4457	+	{$IFDEF TBCDFIELD_IS_BCD}
4458		var
4459		lTempCurr : System.Currency;
4460		begin
#	Line 3798 | Line 4465 | begin
4465		CurrToBCD(lTempCurr, TBCD(Buffer^), 32, Field.Size);
4466		end
4467		else
4468	+	{$ELSE}
4469	+	begin
4470	+	{$ENDIF}
4471		Result := InternalGetFieldData(Field, Buffer);
4472		end;
4473
#	Line 3811 | Line 4481 | begin
4481		end;
4482
4483		procedure TIBCustomDataSet.SetFieldData(Field: TField; Buffer: Pointer);
4484	+	{$IFDEF TDBDFIELD_IS_BCD}
4485		var
4486		lTempCurr : System.Currency;
4487		begin
#	Line 3820 | Line 4491 | begin
4491		InternalSetFieldData(Field, @lTempCurr);
4492		end
4493		else
4494	+	{$ELSE}
4495	+	begin
4496	+	{$ENDIF}
4497		InternalSetFieldData(Field, Buffer);
4498		end;
4499
#	Line 3851 | Line 4525 | begin
4525		FRefreshSQL.Assign(Value);
4526		end;
4527
4528	+	procedure TIBDataSetUpdateObject.InternalSetParams(Query: TIBSQL; buff: PChar);
4529	+	begin
4530	+	if not Assigned(DataSet) then Exit;
4531	+	DataSet.SetInternalSQLParams(Query, buff);
4532	+	end;
4533	+
4534		{ TIBDSBlobStream }
4535		constructor TIBDSBlobStream.Create(AField: TField; ABlobStream: TIBBlobStream;
4536		Mode: TBlobStreamMode);
#	Line 3862 | Line 4542 | begin
4542		FBlobStream.Truncate;
4543		end;
4544
4545	+	destructor TIBDSBlobStream.Destroy;
4546	+	begin
4547	+	if FHasWritten then
4548	+	TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
4549	+	inherited Destroy;
4550	+	end;
4551	+
4552		function TIBDSBlobStream.Read(var Buffer; Count: Longint): Longint;
4553		begin
4554		result := FBlobStream.Read(Buffer, Count);
#	Line 3884 | Line 4571 | begin
4571		TIBCustomDataSet(FField.DataSet).RecordModified(True);
4572		TBlobField(FField).Modified := true;
4573		result := FBlobStream.Write(Buffer, Count);
4574	<	TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, Longint(FField));
4574	>	FHasWritten := true;
4575	>	{  TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
4576	>	Removed as this caused a seek to beginning of the blob stream thus corrupting
4577	>	the blob stream. Moved to the destructor i.e. called after blob written}
4578		end;
4579
4580		{ TIBGenerator }
#	Line 3896 | Line 4586 | begin
4586		FIncrement := AValue
4587		end;
4588
3899	–	function TIBGenerator.GetSelectSQL: string;
3900	–	begin
3901	–	Result := FOwner.SelectSQL.Text
3902	–	end;
3903	–
4589		function TIBGenerator.GetNextValue(ADatabase: TIBDatabase;
4590		ATransaction: TIBTransaction): integer;
4591		begin
#	Line 3914 | Line 4599 | begin
4599		IBError(ibxeCannotSetTransaction,[]);
4600		with Transaction do
4601		if not InTransaction then StartTransaction;
4602	<	SQL.Text := Format('Select Gen_ID(%s,%d) as ID From RDB$Database',[GeneratorName,Increment]);
4602	>	SQL.Text := Format('Select Gen_ID(%s,%d) as ID From RDB$Database',[FGeneratorName,Increment]);
4603		Prepare;
4604		ExecQuery;
4605		try
#	Line 3936 | Line 4621 | end;
4621
4622		procedure TIBGenerator.Apply;
4623		begin
4624	<	if (GeneratorName <> '') and (FieldName <> '')  then
4625	<	Owner.FieldByName(FieldName).AsInteger := GetNextValue(Owner.Database,Owner.Transaction);
4624	>	if (FGeneratorName <> '') and (FFieldName <> '') and Owner.FieldByName(FFieldName).IsNull then
4625	>	Owner.FieldByName(FFieldName).AsInteger := GetNextValue(Owner.Database,Owner.Transaction);
4626		end;
4627
4628	+
4629		end.

Diff Legend

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