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 1 by tony, Mon Jul 31 16:43:00 2000 UTC vs.
Revision 39 by tony, Tue May 17 08:14:52 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	+	{$IF FPC_FULLVERSION >= 20700 }
37	+	{$codepage UTF8}
38	+	{$DEFINE HAS_ANSISTRING_CODEPAGE}
39	+	{$DEFINE NEW_TBOOKMARK}
40	+	{$ENDIF}
41	+
42	+	{$R-}
43	+
44	+	{$Mode Delphi}
45	+
46	+	{$IFDEF DELPHI}
47	+	{$DEFINE TDBDFIELD_IS_BCD}
48	+	{$ENDIF}
49	+
50		interface
51
52		uses
53	<	Windows, SysUtils, Classes, Forms, Controls, StdVCL,
54	<	IBExternals, IB, IBHeader, IBDatabase, IBSQL, Db,
55	<	IBUtils, IBBlob;
53	>	{$IFDEF WINDOWS }
54	>	Windows,
55	>	{$ELSE}
56	>	unix,
57	>	{$ENDIF}
58	>	SysUtils, Classes, IBDatabase, IBExternals, IB, IBHeader,  IBSQL, Db,
59	>	IBUtils, IBBlob, IBSQLParser;
60
61		const
62		BufferCacheSize    =  1000;  { Allocate cache in this many record chunks}
#	Line 43 | Line 66 | type
66		TIBCustomDataSet = class;
67		TIBDataSet = class;
68
69	+	{ TIBDataSetUpdateObject }
70	+
71		TIBDataSetUpdateObject = class(TComponent)
72		private
73		FRefreshSQL: TStrings;
#	Line 50 | Line 75 | type
75		protected
76		function GetDataSet: TIBCustomDataSet; virtual; abstract;
77		procedure SetDataSet(ADataSet: TIBCustomDataSet); virtual; abstract;
78	<	procedure Apply(UpdateKind: TUpdateKind); virtual; abstract;
78	>	procedure Apply(UpdateKind: TUpdateKind; buff: PChar); virtual; abstract;
79		function GetSQL(UpdateKind: TUpdateKind): TStrings; virtual; abstract;
80	+	procedure InternalSetParams(Query: TIBSQL; buff: PChar);
81		property DataSet: TIBCustomDataSet read GetDataSet write SetDataSet;
82		public
83		constructor Create(AOwner: TComponent); override;
#	Line 60 | Line 86 | type
86		property RefreshSQL: TStrings read FRefreshSQL write SetRefreshSQL;
87		end;
88
63	–	PDateTime = ^TDateTime;
89		TBlobDataArray = array[0..0] of TIBBlobStream;
90		PBlobDataArray = ^TBlobDataArray;
91
#	Line 88 | Line 113 | type
113		TRecordData = record
114		rdBookmarkFlag: TBookmarkFlag;
115		rdFieldCount: Short;
116	<	rdRecordNumber: Long;
116	>	rdRecordNumber: Integer;
117		rdCachedUpdateStatus: TCachedUpdateStatus;
118		rdUpdateStatus: TUpdateStatus;
119		rdSavedOffset: DWORD;
#	Line 100 | Line 125 | type
125		{ TIBStringField allows us to have strings longer than 8196 }
126
127		TIBStringField = class(TStringField)
128	+	private
129	+	FCharacterSetName: RawByteString;
130	+	FCharacterSetSize: integer;
131	+	protected
132	+	function GetDefaultWidth: Longint; override;
133		public
134	<	constructor create(AOwner: TComponent); override;
134	>	constructor Create(aOwner: TComponent); override;
135		class procedure CheckTypeSize(Value: Integer); override;
136		function GetAsString: string; override;
137		function GetAsVariant: Variant; override;
138		function GetValue(var Value: string): Boolean;
139		procedure SetAsString(const Value: string); override;
140	+	property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
141	+	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
142	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
143	+	private
144	+	FCodePage: TSystemCodePage;
145	+	public
146	+	property CodePage: TSystemCodePage read FCodePage write FCodePage;
147	+	{$ENDIF}
148	+	end;
149	+
150	+	{ TIBWideStringField }
151	+
152	+	TIBWideStringField = class(TWideStringField)
153	+	private
154	+	FCharacterSetName: RawByteString;
155	+	FCharacterSetSize: integer;
156	+	public
157	+	property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
158	+	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
159		end;
160
161		{ TIBBCDField }
#	Line 129 | Line 178 | type
178		property Size default 8;
179		end;
180
181	+	{TIBMemoField}
182	+	{Allows us to show truncated text in DBGrids and anything else that uses
183	+	DisplayText}
184	+
185	+	TIBMemoField = class(TMemoField)
186	+	private
187	+	FCharacterSetName: RawByteString;
188	+	FCharacterSetSize: integer;
189	+	FDisplayTextAsClassName: boolean;
190	+	function GetTruncatedText: string;
191	+	protected
192	+	function GetAsString: string; override;
193	+	function GetDefaultWidth: Longint; override;
194	+	procedure GetText(var AText: string; ADisplayText: Boolean); override;
195	+	procedure SetAsString(const AValue: string); override;
196	+	public
197	+	constructor Create(AOwner: TComponent); override;
198	+	property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
199	+	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
200	+	published
201	+	property DisplayTextAsClassName: boolean read FDisplayTextAsClassName
202	+	write FDisplayTextAsClassName;
203	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
204	+	private
205	+	FCodePage: TSystemCodePage;
206	+	FFCodePage: TSystemCodePage;
207	+	public
208	+	property CodePage: TSystemCodePage read FFCodePage write FFCodePage;
209	+	{$ENDIF}
210	+	end;
211	+
212	+	{ TIBWideMemoField }
213	+
214	+	TIBWideMemoField = class(TWideMemoField)
215	+	private
216	+	FCharacterSetName: RawByteString;
217	+	FCharacterSetSize: integer;
218	+	FDisplayTextAsClassName: boolean;
219	+	function GetTruncatedText: string;
220	+	protected
221	+	function GetDefaultWidth: Longint; override;
222	+	procedure GetText(var AText: string; ADisplayText: Boolean); override;
223	+	public
224	+	constructor Create(AOwner: TComponent); override;
225	+	property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
226	+	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
227	+	published
228	+	property DisplayTextAsClassName: boolean read FDisplayTextAsClassName
229	+	write FDisplayTextAsClassName;
230	+	end;
231	+
232		TIBDataLink = class(TDetailDataLink)
233		private
234		FDataSet: TIBCustomDataSet;
#	Line 142 | Line 242 | type
242		destructor Destroy; override;
243		end;
244
245	+	TIBGeneratorApplyOnEvent = (gaeOnNewRecord,gaeOnPostRecord);
246	+
247	+	{ TIBGenerator }
248	+
249	+	TIBGenerator = class(TPersistent)
250	+	private
251	+	FOwner: TIBCustomDataSet;
252	+	FApplyOnEvent: TIBGeneratorApplyOnEvent;
253	+	FFieldName: string;
254	+	FGeneratorName: string;
255	+	FIncrement: integer;
256	+	procedure SetIncrement(const AValue: integer);
257	+	protected
258	+	function GetNextValue(ADatabase: TIBDatabase; ATransaction: TIBTransaction): integer;
259	+	public
260	+	constructor Create(Owner: TIBCustomDataSet);
261	+	procedure Apply;
262	+	property Owner: TIBCustomDataSet read FOwner;
263	+	published
264	+	property Generator: string read FGeneratorName write FGeneratorName;
265	+	property Field: string read FFieldName write FFieldName;
266	+	property Increment: integer read FIncrement write SetIncrement default 1;
267	+	property ApplyOnEvent: TIBGeneratorApplyOnEvent read FApplyOnEvent write FApplyOnEvent;
268	+	end;
269	+
270	+	{TIBControlLink - Allows IB Aware controls to react to dataset state changes}
271	+
272	+	TIBControlLink = class
273	+	private
274	+	FTIBDataSet: TIBCustomDataSet;
275	+	procedure SetIBDataSet(AValue: TIBCustomDataSet);
276	+	protected
277	+	procedure UpdateSQL(Sender: TObject); virtual;
278	+	procedure UpdateParams(Sender: TObject); virtual;
279	+	public
280	+	destructor Destroy; override;
281	+	property IBDataSet: TIBCustomDataSet read FTIBDataSet write SetIBDataSet;
282	+	end;
283	+
284	+	TIBAutoCommit = (acDisabled, acCommitRetaining);
285	+
286		{ TIBCustomDataSet }
287		TIBUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApply, uaApplied);
288
289		TIBUpdateErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
290	<	UpdateKind: TUpdateKind; var UpdateAction: TIBUpdateAction)
290	>	UpdateKind: TUpdateKind; var TheUpdateAction: TIBUpdateAction)
291		of object;
292		TIBUpdateRecordEvent = procedure(DataSet: TDataSet; UpdateKind: TUpdateKind;
293		var UpdateAction: TIBUpdateAction) of object;
294
295		TIBUpdateRecordTypes = set of TCachedUpdateStatus;
296
297	+	TDataSetCloseAction = (dcDiscardChanges, dcSaveChanges);
298	+
299	+	TOnValidatePost = procedure (Sender: TObject; var CancelPost: boolean) of object;
300	+
301		TIBCustomDataSet = class(TDataset)
302		private
303	+	FAutoCommit: TIBAutoCommit;
304	+	FGenerateParamNames: Boolean;
305	+	FGeneratorField: TIBGenerator;
306		FNeedsRefresh: Boolean;
307		FForcedRefresh: Boolean;
308		FDidActivate: Boolean;
#	Line 179 | Line 327 | type
327		FDeletedRecords: Long;
328		FModelBuffer,
329		FOldBuffer: PChar;
330	+	FOnValidatePost: TOnValidatePost;
331		FOpen: Boolean;
332		FInternalPrepared: Boolean;
333		FQDelete,
#	Line 189 | Line 338 | type
338		FRecordBufferSize: Integer;
339		FRecordCount: Integer;
340		FRecordSize: Integer;
341	+	FDataSetCloseAction: TDataSetCloseAction;
342		FUniDirectional: Boolean;
343		FUpdateMode: TUpdateMode;
344		FUpdateObject: TIBDataSetUpdateObject;
#	Line 206 | Line 356 | type
356		FBeforeTransactionEnd,
357		FAfterTransactionEnd,
358		FTransactionFree: TNotifyEvent;
359	<
359	>	FAliasNameMap: array of string;
360	>	FAliasNameList: array of string;
361	>	FBaseSQLSelect: TStrings;
362	>	FParser: TSelectSQLParser;
363	>	FCloseAction: TTransactionAction;
364	>	FInTransactionEnd: boolean;
365	>	FIBLinks: TList;
366		function GetSelectStmtHandle: TISC_STMT_HANDLE;
367		procedure SetUpdateMode(const Value: TUpdateMode);
368		procedure SetUpdateObject(Value: TIBDataSetUpdateObject);
#	Line 219 | Line 375 | type
375		function CanRefresh: Boolean;
376		procedure CheckEditState;
377		procedure ClearBlobCache;
378	+	procedure ClearIBLinks;
379		procedure CopyRecordBuffer(Source, Dest: Pointer);
380		procedure DoBeforeDatabaseDisconnect(Sender: TObject);
381		procedure DoAfterDatabaseDisconnect(Sender: TObject);
382		procedure DoDatabaseFree(Sender: TObject);
383	<	procedure DoBeforeTransactionEnd(Sender: TObject);
383	>	procedure DoBeforeTransactionEnd(Sender: TObject; Action: TTransactionAction);
384		procedure DoAfterTransactionEnd(Sender: TObject);
385		procedure DoTransactionFree(Sender: TObject);
386		procedure FetchCurrentRecordToBuffer(Qry: TIBSQL; RecordNumber: Integer;
#	Line 239 | Line 396 | type
396		function GetModifySQL: TStrings;
397		function GetTransaction: TIBTransaction;
398		function GetTRHandle: PISC_TR_HANDLE;
399	<	procedure InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer);
399	>	function GetParser: TSelectSQLParser;
400	>	procedure InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer); virtual;
401		function InternalLocate(const KeyFields: string; const KeyValues: Variant;
402		Options: TLocateOptions): Boolean; virtual;
403	<	procedure InternalPostRecord(Qry: TIBSQL; Buff: Pointer);
404	<	procedure InternalRevertRecord(RecordNumber: Integer);
403	>	procedure InternalPostRecord(Qry: TIBSQL; Buff: Pointer); virtual;
404	>	procedure InternalRevertRecord(RecordNumber: Integer); virtual;
405		function IsVisible(Buffer: PChar): Boolean;
406	+	procedure RegisterIBLink(Sender: TIBControlLink);
407	+	procedure UnRegisterIBLink(Sender: TIBControlLink);
408		procedure SaveOldBuffer(Buffer: PChar);
409		procedure SetBufferChunks(Value: Integer);
410		procedure SetDatabase(Value: TIBDatabase);
#	Line 258 | Line 418 | type
418		procedure SetUpdateRecordTypes(Value: TIBUpdateRecordTypes);
419		procedure SetUniDirectional(Value: Boolean);
420		procedure RefreshParams;
261	–	procedure SQLChanging(Sender: TObject); virtual;
421		function AdjustPosition(FCache: PChar; Offset: DWORD;
422	<	Origin: Integer): Integer;
422	>	Origin: Integer): DWORD;
423		procedure ReadCache(FCache: PChar; Offset: DWORD; Origin: Integer;
424		Buffer: PChar);
425		procedure ReadRecordCache(RecordNumber: Integer; Buffer: PChar;
#	Line 269 | Line 428 | type
428		Buffer: PChar);
429		procedure WriteRecordCache(RecordNumber: Integer; Buffer: PChar);
430		function InternalGetRecord(Buffer: PChar; GetMode: TGetMode;
431	<	DoCheck: Boolean): TGetResult;
431	>	DoCheck: Boolean): TGetResult; virtual;
432
433		protected
434		procedure ActivateConnection;
#	Line 277 | Line 436 | type
436		procedure DeactivateTransaction;
437		procedure CheckDatasetClosed;
438		procedure CheckDatasetOpen;
439	+	function CreateParser: TSelectSQLParser; virtual;
440	+	procedure FieldDefsFromQuery(SourceQuery: TIBSQL);
441		function GetActiveBuf: PChar;
442	<	procedure InternalBatchInput(InputObject: TIBBatchInput);
443	<	procedure InternalBatchOutput(OutputObject: TIBBatchOutput);
442	>	procedure InternalBatchInput(InputObject: TIBBatchInput); virtual;
443	>	procedure InternalBatchOutput(OutputObject: TIBBatchOutput); virtual;
444		procedure InternalPrepare; virtual;
445		procedure InternalUnPrepare; virtual;
446		procedure InternalExecQuery; virtual;
447		procedure InternalRefreshRow; virtual;
448	<	procedure InternalSetParamsFromCursor;
448	>	procedure InternalSetParamsFromCursor; virtual;
449		procedure CheckNotUniDirectional;
450	+	procedure SQLChanging(Sender: TObject); virtual;
451	+	procedure SQLChanged(Sender: TObject); virtual;
452
453	<	{ IProviderSupport }
453	>	(*    { IProviderSupport }
454		procedure PSEndTransaction(Commit: Boolean); override;
455		function PSExecuteStatement(const ASQL: string; AParams: TParams;
456		ResultSet: Pointer = nil): Integer; override;
#	Line 300 | Line 463 | type
463		procedure PSStartTransaction; override;
464		procedure PSReset; override;
465		function PSUpdateRecord(UpdateKind: TUpdateKind; Delta: TDataSet): Boolean; override;
466	<
466	>	*)
467		{ TDataSet support }
468		procedure InternalInsert; override;
469		procedure InitRecord(Buffer: PChar); override;
#	Line 309 | Line 472 | type
472		procedure ClearCalcFields(Buffer: PChar); override;
473		function AllocRecordBuffer: PChar; override;
474		procedure DoBeforeDelete; override;
475	+	procedure DoAfterDelete; override;
476		procedure DoBeforeEdit; override;
477	+	procedure DoAfterEdit; override;
478		procedure DoBeforeInsert; override;
479	+	procedure DoAfterInsert; override;
480	+	procedure DoBeforeClose; override;
481	+	procedure DoBeforeOpen; override;
482	+	procedure DoBeforePost; override;
483	+	procedure DoAfterPost; override;
484		procedure FreeRecordBuffer(var Buffer: PChar); override;
485		procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
486		function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
487		function GetCanModify: Boolean; override;
488		function GetDataSource: TDataSource; override;
489	+	function GetDBAliasName(FieldNo: integer): string;
490	+	function GetFieldDefFromAlias(aliasName: string): TFieldDef;
491		function GetFieldClass(FieldType: TFieldType): TFieldClass; override;
492		function GetRecNo: Integer; override;
493		function GetRecord(Buffer: PChar; GetMode: TGetMode;
494		DoCheck: Boolean): TGetResult; override;
495		function GetRecordCount: Integer; override;
496		function GetRecordSize: Word; override;
497	+	procedure InternalAutoCommit;
498		procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override;
499		procedure InternalCancel; override;
500		procedure InternalClose; override;
501		procedure InternalDelete; override;
502		procedure InternalFirst; override;
503	<	function InternalGetFieldData(Field: TField; Buffer: Pointer): Boolean;
503	>	function InternalGetFieldData(Field: TField; Buffer: Pointer): Boolean; virtual;
504		procedure InternalGotoBookmark(Bookmark: Pointer); override;
505		procedure InternalHandleException; override;
506		procedure InternalInitFieldDefs; override;
#	Line 336 | Line 509 | type
509		procedure InternalOpen; override;
510		procedure InternalPost; override;
511		procedure InternalRefresh; override;
512	<	procedure InternalSetFieldData(Field: TField; Buffer: Pointer);
512	>	procedure InternalSetFieldData(Field: TField; Buffer: Pointer); virtual;
513		procedure InternalSetToRecord(Buffer: PChar); override;
514		function IsCursorOpen: Boolean; override;
515	+	procedure Loaded; override;
516		procedure ReQuery;
517		procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
518		procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
519		procedure SetCachedUpdates(Value: Boolean);
520		procedure SetDataSource(Value: TDataSource);
521	+	procedure SetGenerateParamNames(AValue: Boolean); virtual;
522		procedure SetFieldData(Field : TField; Buffer : Pointer); override;
523		procedure SetFieldData(Field : TField; Buffer : Pointer;
524		NativeFormat : Boolean); overload; override;
#	Line 351 | Line 526 | type
526
527		protected
528		{Likely to be made public by descendant classes}
529	+	property AutoCommit: TIBAutoCommit read FAutoCommit write FAutoCommit default acDisabled;
530		property SQLParams: TIBXSQLDA read GetSQLParams;
531		property Params: TIBXSQLDA read GetSQLParams;
532		property InternalPrepared: Boolean read FInternalPrepared;
#	Line 366 | Line 542 | type
542		property BufferChunks: Integer read FBufferChunks write SetBufferChunks;
543		property CachedUpdates: Boolean read FCachedUpdates write SetCachedUpdates;
544		property UniDirectional: Boolean read FUniDirectional write SetUniDirectional default False;
545	+	property GeneratorField: TIBGenerator read FGeneratorField write FGeneratorField;
546		property DeleteSQL: TStrings read GetDeleteSQL write SetDeleteSQL;
547		property InsertSQL: TStrings read GetInsertSQL write SetInsertSQL;
548		property RefreshSQL: TStrings read GetRefreshSQL write SetRefreshSQL;
#	Line 373 | Line 550 | type
550		property ModifySQL: TStrings read GetModifySQL write SetModifySQL;
551		property UpdateMode: TUpdateMode read FUpdateMode write SetUpdateMode default upWhereAll;
552		property ParamCheck: Boolean read FParamCheck write FParamCheck default True;
553	+	property Parser: TSelectSQLParser read GetParser;
554	+	property BaseSQLSelect: TStrings read FBaseSQLSelect;
555
556		property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect
557		write FBeforeDatabaseDisconnect;
#	Line 386 | Line 565 | type
565		write FAfterTransactionEnd;
566		property TransactionFree: TNotifyEvent read FTransactionFree
567		write FTransactionFree;
568	+	property OnValidatePost: TOnValidatePost read FOnValidatePost write FOnValidatePost;
569
570		public
571		constructor Create(AOwner: TComponent); override;
#	Line 393 | Line 573 | type
573		procedure ApplyUpdates;
574		function CachedUpdateStatus: TCachedUpdateStatus;
575		procedure CancelUpdates;
576	+	function GetFieldPosition(AliasName: string): integer;
577		procedure FetchAll;
578		function LocateNext(const KeyFields: string; const KeyValues: Variant;
579		Options: TLocateOptions): Boolean;
580		procedure RecordModified(Value: Boolean);
581		procedure RevertRecord;
582		procedure Undelete;
583	+	procedure ResetParser; virtual;
584	+	function HasParser: boolean;
585
586		{ TDataSet support methods }
587		function BookmarkValid(Bookmark: TBookmark): Boolean; override;
#	Line 406 | Line 589 | type
589		function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
590		function GetCurrentRecord(Buffer: PChar): Boolean; override;
591		function GetFieldData(Field : TField; Buffer : Pointer) : Boolean; overload; override;
592	<	function GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; overload; override;
592	>	function GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; overload; (*override;*)
593		function GetFieldData(Field : TField; Buffer : Pointer;
594		NativeFormat : Boolean) : Boolean; overload; override;
595	+	property GenerateParamNames: Boolean read FGenerateParamNames write SetGenerateParamNames;
596		function Locate(const KeyFields: string; const KeyValues: Variant;
597		Options: TLocateOptions): Boolean; override;
598		function Lookup(const KeyFields: string; const KeyValues: Variant;
599		const ResultFields: string): Variant; override;
600		function UpdateStatus: TUpdateStatus; override;
601		function IsSequenced: Boolean; override;
602	<
602	>	procedure Post; override;
603	>	function ParamByName(ParamName: String): TIBXSQLVAR;
604		property DBHandle: PISC_DB_HANDLE read GetDBHandle;
605		property TRHandle: PISC_TR_HANDLE read GetTRHandle;
606		property UpdateObject: TIBDataSetUpdateObject read FUpdateObject write SetUpdateObject;
607		property UpdatesPending: Boolean read FUpdatesPending;
608		property UpdateRecordTypes: TIBUpdateRecordTypes read FUpdateRecordTypes
609		write SetUpdateRecordTypes;
610	+	property DataSetCloseAction: TDataSetCloseAction
611	+	read FDataSetCloseAction write FDataSetCloseAction;
612
613		published
614		property Database: TIBDatabase read GetDatabase write SetDatabase;
#	Line 430 | Line 617 | type
617		property ForcedRefresh: Boolean read FForcedRefresh
618		write FForcedRefresh default False;
619		property AutoCalcFields;
433	–	property ObjectView default False;
620
621		property AfterCancel;
622		property AfterClose;
#	Line 461 | Line 647 | type
647		write FOnUpdateRecord;
648		end;
649
650	<	TIBDataSet = class(TIBCustomDataSet)
650	>	TIBParserDataSet = class(TIBCustomDataSet)
651	>	public
652	>	property Parser;
653	>	end;
654	>
655	>	TIBDataSet = class(TIBParserDataSet)
656		private
657		function GetPrepared: Boolean;
658
#	Line 486 | Line 677 | type
677		property QModify;
678		property StatementType;
679		property SelectStmtHandle;
680	+	property BaseSQLSelect;
681
682		published
683		{ TIBCustomDataSet }
684	+	property AutoCommit;
685		property BufferChunks;
686		property CachedUpdates;
687		property DeleteSQL;
#	Line 496 | Line 689 | type
689		property RefreshSQL;
690		property SelectSQL;
691		property ModifySQL;
692	+	property GeneratorField;
693	+	property GenerateParamNames;
694		property ParamCheck;
695		property UniDirectional;
696		property Filtered;
697	+	property DataSetCloseAction;
698
699		property BeforeDatabaseDisconnect;
700		property AfterDatabaseDisconnect;
#	Line 534 | Line 730 | type
730		property OnFilterRecord;
731		property OnNewRecord;
732		property OnPostError;
733	+	property OnValidatePost;
734		end;
735
736		{ TIBDSBlobStream }
737		TIBDSBlobStream = class(TStream)
738	+	private
739	+	FHasWritten: boolean;
740		protected
741		FField: TField;
742		FBlobStream: TIBBlobStream;
743		public
744		constructor Create(AField: TField; ABlobStream: TIBBlobStream;
745		Mode: TBlobStreamMode);
746	+	destructor Destroy; override;
747		function Read(var Buffer; Count: Longint): Longint; override;
748		function Seek(Offset: Longint; Origin: Word): Longint; override;
749		procedure SetSize(NewSize: Longint); override;
#	Line 568 | Line 768 | DefaultFieldClasses: array[TFieldType] o
768		TVarBytesField,     { ftVarBytes }
769		TAutoIncField,      { ftAutoInc }
770		TBlobField,         { ftBlob }
771	<	TMemoField,         { ftMemo }
771	>	TIBMemoField,       { ftMemo }
772		TGraphicField,      { ftGraphic }
773		TBlobField,         { ftFmtMemo }
774		TBlobField,         { ftParadoxOle }
#	Line 576 | Line 776 | DefaultFieldClasses: array[TFieldType] o
776		TBlobField,         { ftTypedBinary }
777		nil,                { ftCursor }
778		TStringField,       { ftFixedChar }
779	<	nil, {TWideStringField } { ftWideString }
779	>	TIBWideStringField,    { ftWideString }
780		TLargeIntField,     { ftLargeInt }
781	+	nil,          { ftADT }
782	+	nil,        { ftArray }
783	+	nil,    { ftReference }
784	+	nil,     { ftDataSet }
785	+	TBlobField,         { ftOraBlob }
786	+	TMemoField,         { ftOraClob }
787	+	TVariantField,      { ftVariant }
788	+	nil,    { ftInterface }
789	+	nil,     { ftIDispatch }
790	+	TGuidField,        { ftGuid }
791	+	TDateTimeField,    {ftTimestamp}
792	+	TIBBCDField,       {ftFMTBcd}
793	+	nil,  {ftFixedWideChar}
794	+	TIBWideMemoField);   {ftWideMemo}
795	+	(*
796		TADTField,          { ftADT }
797		TArrayField,        { ftArray }
798		TReferenceField,    { ftReference }
#	Line 587 | Line 802 | DefaultFieldClasses: array[TFieldType] o
802		TVariantField,      { ftVariant }
803		TInterfaceField,    { ftInterface }
804		TIDispatchField,     { ftIDispatch }
805	<	TGuidField);        { ftGuid }
806	<	var
807	<	CreateProviderProc: function(DataSet: TIBCustomDataSet): IProvider = nil;
805	>	TGuidField);        { ftGuid } *)
806	>	(*var
807	>	CreateProviderProc: function(DataSet: TIBCustomDataSet): IProvider = nil;*)
808
809		implementation
810
811	<	uses IBIntf, IBQuery;
811	>	uses IBIntf, Variants, FmtBCD, LazUTF8;
812	>
813	>	const FILE_BEGIN = 0;
814	>	FILE_CURRENT = 1;
815	>	FILE_END = 2;
816
817		type
818
#	Line 612 | Line 831 | type
831		NextRelation : TRelationNode;
832		end;
833
834	+	{Extended Field Def for character set info}
835	+
836	+	{ TIBFieldDef }
837	+
838	+	TIBFieldDef = class(TFieldDef)
839	+	private
840	+	FCharacterSetName: RawByteString;
841	+	FCharacterSetSize: integer;
842	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
843	+	FCodePage: TSystemCodePage;
844	+	{$ENDIF}
845	+	published
846	+	property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
847	+	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
848	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
849	+	property CodePage: TSystemCodePage read FCodePage write FCodePage;
850	+	{$ENDIF}
851	+	end;
852	+
853	+
854	+	{  Copied from LCLProc in order to avoid LCL dependency
855	+
856	+	Ensures the covenient look of multiline string
857	+	when displaying it in the single line
858	+	* Replaces CR and LF with spaces
859	+	* Removes duplicate spaces
860	+	}
861	+	function TextToSingleLine(const AText: string): string;
862	+	var
863	+	str: string;
864	+	i, wstart, wlen: Integer;
865	+	begin
866	+	str := Trim(AText);
867	+	wstart := 0;
868	+	wlen := 0;
869	+	i := 1;
870	+	while i < Length(str) - 1 do
871	+	begin
872	+	if (str[i] in [' ', #13, #10]) then
873	+	begin
874	+	if (wstart = 0) then
875	+	begin
876	+	wstart := i;
877	+	wlen := 1;
878	+	end else
879	+	Inc(wlen);
880	+	end else
881	+	begin
882	+	if wstart > 0 then
883	+	begin
884	+	str[wstart] := ' ';
885	+	Delete(str, wstart+1, wlen-1);
886	+	Dec(i, wlen-1);
887	+	wstart := 0;
888	+	end;
889	+	end;
890	+	Inc(i);
891	+	end;
892	+	Result := str;
893	+	end;
894	+
895	+	{ TIBWideMemoField }
896	+
897	+	function TIBWideMemoField.GetTruncatedText: string;
898	+	begin
899	+	Result := GetAsString;
900	+
901	+	if Result <> '' then
902	+	if DisplayWidth = 0 then
903	+	Result := TextToSingleLine(Result)
904	+	else
905	+	if Length(Result) > DisplayWidth then {Show truncation with elipses}
906	+	Result := TextToSingleLine(system.copy(Result,1,DisplayWidth-3)) + '...';
907	+	end;
908	+
909	+	function TIBWideMemoField.GetDefaultWidth: Longint;
910	+	begin
911	+	Result := 128;
912	+	end;
913	+
914	+	procedure TIBWideMemoField.GetText(var AText: string; ADisplayText: Boolean);
915	+	begin
916	+	if ADisplayText then
917	+	begin
918	+	if not DisplayTextAsClassName and (CharacterSetName<> '') then
919	+	AText := GetTruncatedText
920	+	else
921	+	inherited GetText(AText, ADisplayText);
922	+	end
923	+	else
924	+	AText := GetAsString;
925	+	end;
926	+
927	+	constructor TIBWideMemoField.Create(AOwner: TComponent);
928	+	begin
929	+	inherited Create(AOwner);
930	+	BlobType := ftWideMemo;
931	+	end;
932	+
933	+	{ TIBMemoField }
934	+
935	+	function TIBMemoField.GetTruncatedText: string;
936	+	begin
937	+	Result := GetAsString;
938	+
939	+	if Result <> '' then
940	+	begin
941	+	case CharacterSetSize of
942	+	1:
943	+	if DisplayWidth = 0 then
944	+	Result := TextToSingleLine(Result)
945	+	else
946	+	if Length(Result) > DisplayWidth then {Show truncation with elipses}
947	+	Result := TextToSingleLine(system.copy(Result,1,DisplayWidth-3)) + '...';
948	+
949	+	{2: case 2 ignored. This should be handled by TIBWideMemo}
950	+
951	+	3, {Assume UNICODE_FSS is really UTF8}
952	+	4: {Include GB18030 - assuming UTF8 routine work for this codeset}
953	+	if DisplayWidth = 0 then
954	+	Result := ValidUTF8String(TextToSingleLine(Result))
955	+	else
956	+	if UTF8Length(Result) > DisplayWidth then {Show truncation with elipses}
957	+	Result := ValidUTF8String(TextToSingleLine(UTF8Copy(Result,1,DisplayWidth-3))) + '...';
958	+	end;
959	+	end
960	+	end;
961	+
962	+	function TIBMemoField.GetAsString: string;
963	+	var s: RawByteString;
964	+	begin
965	+	s := inherited GetAsString;
966	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
967	+	SetCodePage(s,CodePage,false);
968	+	{$ENDIF}
969	+	Result := s;
970	+	end;
971	+
972	+	function TIBMemoField.GetDefaultWidth: Longint;
973	+	begin
974	+	if DisplayTextAsClassName then
975	+	Result := inherited
976	+	else
977	+	Result := 128;
978	+	end;
979	+
980	+	procedure TIBMemoField.GetText(var AText: string; ADisplayText: Boolean);
981	+	begin
982	+	if ADisplayText then
983	+	begin
984	+	if not DisplayTextAsClassName and (CharacterSetName <> '') then
985	+	AText := GetTruncatedText
986	+	else
987	+	inherited GetText(AText, ADisplayText);
988	+	end
989	+	else
990	+	AText := GetAsString;
991	+	end;
992	+
993	+	procedure TIBMemoField.SetAsString(const AValue: string);
994	+	var s: RawByteString;
995	+	begin
996	+	s := AValue;
997	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
998	+	if StringCodePage(Value) <> CodePage then
999	+	SetCodePage(s,CodePage,true);
1000	+	{$ENDIF}
1001	+	inherited SetAsString(s);
1002	+	end;
1003	+
1004	+	constructor TIBMemoField.Create(AOwner: TComponent);
1005	+	begin
1006	+	inherited Create(AOwner);
1007	+	BlobType := ftMemo;
1008	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1009	+	FCodePage := CP_NONE;
1010	+	{$ENDIF}
1011	+	end;
1012	+
1013	+	{ TIBControlLink }
1014	+
1015	+	destructor TIBControlLink.Destroy;
1016	+	begin
1017	+	IBDataSet := nil;
1018	+	inherited Destroy;
1019	+	end;
1020	+
1021	+	procedure TIBControlLink.UpdateParams(Sender: TObject);
1022	+	begin
1023	+
1024	+	end;
1025	+
1026	+	procedure TIBControlLink.UpdateSQL(Sender: TObject);
1027	+	begin
1028	+
1029	+	end;
1030	+
1031	+	procedure TIBControlLink.SetIBDataSet(AValue: TIBCustomDataSet);
1032	+	begin
1033	+	if FTIBDataSet = AValue then Exit;
1034	+	if IBDataSet <> nil then
1035	+	IBDataSet.UnRegisterIBLink(self);
1036	+	FTIBDataSet := AValue;
1037	+	if IBDataSet <> nil then
1038	+	IBDataSet.RegisterIBLink(self);
1039	+	end;
1040	+
1041
1042		{ TIBStringField}
1043
1044	<	constructor TIBStringField.Create(AOwner: TComponent);
1044	>	function TIBStringField.GetDefaultWidth: Longint;
1045	>	begin
1046	>	Result := Size div CharacterSetSize;
1047	>	end;
1048	>
1049	>	constructor TIBStringField.Create(aOwner: TComponent);
1050		begin
1051	<	inherited;
1051	>	inherited Create(aOwner);
1052	>	FCharacterSetSize := 1;
1053	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1054	>	FCodePage := CP_NONE;
1055	>	{$ENDIF}
1056		end;
1057
1058		class procedure TIBStringField.CheckTypeSize(Value: Integer);
#	Line 640 | Line 1075 | end;
1075		function TIBStringField.GetValue(var Value: string): Boolean;
1076		var
1077		Buffer: PChar;
1078	+	s: RawByteString;
1079		begin
1080		Buffer := nil;
1081		IBAlloc(Buffer, 0, Size + 1);
#	Line 647 | Line 1083 | begin
1083		Result := GetData(Buffer);
1084		if Result then
1085		begin
1086	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1087	+	s := string(Buffer);
1088	+	SetCodePage(s,CodePage,false);
1089	+	Value := s;
1090	+	//      writeln(FieldName,': ', StringCodePage(Value),', ',Value);
1091	+	{$ELSE}
1092		Value := string(Buffer);
1093	+	{$ENDIF}
1094		if Transliterate and (Value <> '') then
1095		DataSet.Translate(PChar(Value), PChar(Value), False);
1096		end
#	Line 659 | Line 1102 | end;
1102		procedure TIBStringField.SetAsString(const Value: string);
1103		var
1104		Buffer: PChar;
1105	+	s: RawByteString;
1106		begin
1107		Buffer := nil;
1108		IBAlloc(Buffer, 0, Size + 1);
1109		try
1110	<	StrLCopy(Buffer, PChar(Value), Size);
1110	>	s := Value;
1111	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1112	>	if StringCodePage(s) <> CodePage then
1113	>	SetCodePage(s,CodePage,true);
1114	>	{$ENDIF}
1115	>	StrLCopy(Buffer, PChar(s), Size);
1116		if Transliterate then
1117		DataSet.Translate(Buffer, Buffer, True);
1118		SetData(Buffer);
#	Line 672 | Line 1121 | begin
1121		end;
1122		end;
1123
1124	+
1125		{ TIBBCDField }
1126
1127		constructor TIBBCDField.Create(AOwner: TComponent);
#	Line 714 | Line 1164 | end;
1164
1165		function TIBBCDField.GetDataSize: Integer;
1166		begin
1167	+	{$IFDEF TBCDFIELD_IS_BCD}
1168		Result := 8;
1169	+	{$ELSE}
1170	+	Result := inherited GetDataSize
1171	+	{$ENDIF}
1172		end;
1173
1174		{ TIBDataLink }
#	Line 728 | Line 1182 | end;
1182		destructor TIBDataLink.Destroy;
1183		begin
1184		FDataSet.FDataLink := nil;
1185	<	inherited;
1185	>	inherited Destroy;
1186		end;
1187
1188
#	Line 760 | Line 1214 | end;
1214
1215		constructor TIBCustomDataSet.Create(AOwner: TComponent);
1216		begin
1217	<	inherited;
1217	>	inherited Create(AOwner);
1218		FIBLoaded := False;
1219		CheckIBLoaded;
1220		FIBLoaded := True;
1221		FBase := TIBBase.Create(Self);
1222	+	FIBLinks := TList.Create;
1223		FCurrentRecord := -1;
1224		FDeletedRecords := 0;
1225		FUniDirectional := False;
1226		FBufferChunks := BufferCacheSize;
1227		FBlobStreamList := TList.Create;
1228	+	FGeneratorField := TIBGenerator.Create(self);
1229		FDataLink := TIBDataLink.Create(Self);
1230		FQDelete := TIBSQL.Create(Self);
1231		FQDelete.OnSQLChanging := SQLChanging;
#	Line 782 | Line 1238 | begin
1238		FQRefresh.GoToFirstRecordOnExecute := False;
1239		FQSelect := TIBSQL.Create(Self);
1240		FQSelect.OnSQLChanging := SQLChanging;
1241	+	FQSelect.OnSQLChanged := SQLChanged;
1242		FQSelect.GoToFirstRecordOnExecute := False;
1243		FQModify := TIBSQL.Create(Self);
1244		FQModify.OnSQLChanging := SQLChanging;
1245		FQModify.GoToFirstRecordOnExecute := False;
1246		FUpdateRecordTypes := [cusUnmodified, cusModified, cusInserted];
1247		FParamCheck := True;
1248	+	FGenerateParamNames := False;
1249		FForcedRefresh := False;
1250	+	FAutoCommit:= acDisabled;
1251	+	FDataSetCloseAction := dcDiscardChanges;
1252		{Bookmark Size is Integer for IBX}
1253		BookmarkSize := SizeOf(Integer);
1254		FBase.BeforeDatabaseDisconnect := DoBeforeDatabaseDisconnect;
#	Line 802 | Line 1262 | begin
1262		else
1263		if AOwner is TIBTransaction then
1264		Transaction := TIBTransaction(AOwner);
1265	+	FBaseSQLSelect := TStringList.Create;
1266		end;
1267
1268		destructor TIBCustomDataSet.Destroy;
1269		begin
1270	<	inherited;
1270	>	if Active then Active := false;
1271		if FIBLoaded then
1272		begin
1273	+	if assigned(FGeneratorField) then FGeneratorField.Free;
1274		FDataLink.Free;
1275		FBase.Free;
1276		ClearBlobCache;
1277	+	ClearIBLinks;
1278	+	FIBLinks.Free;
1279		FBlobStreamList.Free;
1280		FreeMem(FBufferCache);
1281		FBufferCache := nil;
#	Line 821 | Line 1285 | begin
1285		FOldCacheSize := 0;
1286		FMappedFieldPosition := nil;
1287		end;
1288	+	if assigned(FBaseSQLSelect) then FBaseSQLSelect.Free;
1289	+	if assigned(FParser) then FParser.Free;
1290	+	inherited Destroy;
1291		end;
1292
1293		function TIBCustomDataSet.AdjustCurrentRecord(Buffer: Pointer; GetMode: TGetMode):
#	Line 861 | Line 1328 | end;
1328
1329		procedure TIBCustomDataSet.ApplyUpdates;
1330		var
1331	+	{$IFDEF NEW_TBOOKMARK }
1332	+	CurBookmark: TBookmark;
1333	+	{$ELSE}
1334		CurBookmark: string;
1335	+	{$ENDIF}
1336		Buffer: PRecordData;
1337		CurUpdateTypes: TIBUpdateRecordTypes;
1338		UpdateAction: TIBUpdateAction;
#	Line 921 | Line 1392 | var
1392		procedure UpdateUsingUpdateObject;
1393		begin
1394		try
1395	<	FUpdateObject.Apply(UpdateKind);
1395	>	FUpdateObject.Apply(UpdateKind,PChar(Buffer));
1396		ResetBufferUpdateStatus;
1397		except
1398		on E: Exception do
#	Line 1059 | Line 1530 | begin
1530		end;
1531		end;
1532
1533	+	function TIBCustomDataSet.GetFieldPosition(AliasName: string): integer;
1534	+	var i: integer;
1535	+	Prepared: boolean;
1536	+	begin
1537	+	Result := 0;
1538	+	Prepared := FInternalPrepared;
1539	+	if not Prepared then
1540	+	InternalPrepare;
1541	+	try
1542	+	for i := 0 to Length(FAliasNameList) - 1 do
1543	+	if FAliasNameList[i] = AliasName then
1544	+	begin
1545	+	Result := i + 1;
1546	+	Exit
1547	+	end;
1548	+	finally
1549	+	if not Prepared then
1550	+	InternalUnPrepare;
1551	+	end;
1552	+	end;
1553	+
1554		procedure TIBCustomDataSet.ActivateConnection;
1555		begin
1556		if not Assigned(Database) then
#	Line 1119 | Line 1611 | begin
1611		IBError(ibxeDatasetClosed, [nil]);
1612		end;
1613
1614	+	function TIBCustomDataSet.CreateParser: TSelectSQLParser;
1615	+	begin
1616	+	Result := TSelectSQLParser.Create(self,FBaseSQLSelect);
1617	+	Result.OnSQLChanging := SQLChanging
1618	+	end;
1619	+
1620		procedure TIBCustomDataSet.CheckNotUniDirectional;
1621		begin
1622		if UniDirectional then
#	Line 1222 | Line 1720 | begin
1720		FDatabaseFree(Sender);
1721		end;
1722
1723	<	procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject);
1723	>	procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject;
1724	>	Action: TTransactionAction);
1725		begin
1726	<	if Active then
1727	<	Active := False;
1726	>	FCloseAction := Action;
1727	>	FInTransactionEnd := true;
1728	>	try
1729	>	if Active then
1730	>	Active := False;
1731	>	finally
1732	>	FInTransactionEnd := false;
1733	>	end;
1734		if FQSelect <> nil then
1735		FQSelect.FreeHandle;
1736		if FQDelete <> nil then
#	Line 1263 | Line 1768 | var
1768		LocalData: Pointer;
1769		LocalDate, LocalDouble: Double;
1770		LocalInt: Integer;
1771	+	LocalBool: wordBool;
1772		LocalInt64: Int64;
1773		LocalCurrency: Currency;
1774		FieldsLoaded: Integer;
1775	+	temp: TIBXSQLVAR;
1776		begin
1777		p := PRecordData(Buffer);
1778		{ Make sure blob cache is empty }
#	Line 1399 | Line 1906 | begin
1906		if (rdFields[j].fdDataLength = 0) then
1907		LocalData := nil
1908		else
1909	<	LocalData := @Qry.Current[i].Data^.sqldata[2];
1909	>	begin
1910	>	temp :=  Qry.Current[i];
1911	>	LocalData := @temp.Data^.sqldata[2];
1912	>	(*              LocalData := @Qry.Current[i].Data^.sqldata[2];*)
1913	>	end;
1914		end;
1915		end;
1916	+	SQL_BOOLEAN:
1917	+	begin
1918	+	LocalBool:= false;
1919	+	rdFields[j].fdDataSize := SizeOf(wordBool);
1920	+	if RecordNumber >= 0 then
1921	+	LocalBool := Qry.Current[i].AsBoolean;
1922	+	LocalData := PChar(@LocalBool);
1923	+	end;
1924		else { SQL_TEXT, SQL_BLOB, SQL_ARRAY, SQL_QUAD }
1925		begin
1926		rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
#	Line 1526 | Line 2045 | end;
2045		procedure TIBCustomDataSet.InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer);
2046		begin
2047		if (Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukDelete).Text <> '')) then
2048	<	FUpdateObject.Apply(ukDelete)
2048	>	FUpdateObject.Apply(ukDelete,Buff)
2049		else
2050		begin
2051		SetInternalSQLParams(FQDelete, Buff);
#	Line 1543 | Line 2062 | end;
2062		function TIBCustomDataSet.InternalLocate(const KeyFields: string;
2063		const KeyValues: Variant; Options: TLocateOptions): Boolean;
2064		var
2065	<	fl: TList;
2065	>	keyFieldList: TList;
2066	>	{$IFDEF NEW_TBOOKMARK }
2067	>	CurBookmark: TBookmark;
2068	>	{$ELSE}
2069		CurBookmark: string;
2070	<	fld, val: Variant;
2071	<	i, fld_cnt: Integer;
2070	>	{$ENDIF}
2071	>	fieldValue: Variant;
2072	>	lookupValues: array of variant;
2073	>	i, fieldCount: Integer;
2074	>	fieldValueAsString: string;
2075	>	lookupValueAsString: string;
2076		begin
2077	<	fl := TList.Create;
2077	>	keyFieldList := TList.Create;
2078		try
2079	<	GetFieldList(fl, KeyFields);
2080	<	fld_cnt := fl.Count;
2079	>	GetFieldList(keyFieldList, KeyFields);
2080	>	fieldCount := keyFieldList.Count;
2081		CurBookmark := Bookmark;
2082	<	result := False;
2083	<	while ((not result) and (not EOF)) do
2082	>	result := false;
2083	>	SetLength(lookupValues, fieldCount);
2084	>	if not EOF then
2085		begin
2086	<	i := 0;
1560	<	result := True;
1561	<	while (result and (i < fld_cnt)) do
2086	>	for i := 0 to fieldCount - 1 do  {expand key values into lookupValues array}
2087		begin
2088	<	if fld_cnt > 1 then
2089	<	val := KeyValues[i]
2088	>	if VarIsArray(KeyValues) then
2089	>	lookupValues[i] := KeyValues[i]
2090	>	else
2091	>	if i > 0 then
2092	>	lookupValues[i] := NULL
2093		else
2094	<	val := KeyValues;
2095	<	fld := TField(fl[i]).Value;
2096	<	result := not (VarIsNull(val) xor VarIsNull(fld));
2097	<	if result and not VarIsNull(val) then
2094	>	lookupValues[0] := KeyValues;
2095	>
2096	>	{convert to upper case is case insensitive search}
2097	>	if (TField(keyFieldList[i]).DataType = ftString) and
2098	>	not VarIsNull(lookupValues[i]) and (loCaseInsensitive in Options) then
2099	>	lookupValues[i] := UpperCase(lookupValues[i]);
2100	>	end;
2101	>	end;
2102	>	while not result and not EOF do   {search for a matching record}
2103	>	begin
2104	>	i := 0;
2105	>	result := true;
2106	>	while result and (i < fieldCount) do
2107	>	{see if all of the key fields matches}
2108	>	begin
2109	>	fieldValue := TField(keyFieldList[i]).Value;
2110	>	result := not (VarIsNull(fieldValue) xor VarIsNull(lookupValues[i]));
2111	>	if result and not VarIsNull(fieldValue) then
2112		begin
2113		try
2114	<	fld := VarAsType(fld, VarType(val));
1573	<	except
1574	<	on E: EVariantError do result := False;
1575	<	end;
1576	<	if Result then
1577	<	if TField(fl[i]).DataType = ftString then
2114	>	if TField(keyFieldList[i]).DataType = ftString then
2115		begin
2116	+	{strings need special handling because of the locate options that
2117	+	apply to them}
2118	+	fieldValueAsString := TField(keyFieldList[i]).AsString;
2119	+	lookupValueAsString := lookupValues[i];
2120		if (loCaseInsensitive in Options) then
2121	<	begin
2122	<	fld := AnsiUpperCase(fld);
1582	<	val := AnsiUpperCase(val);
1583	<	end;
1584	<	fld := TrimRight(fld);
1585	<	val := TrimRight(val);
2121	>	fieldValueAsString := UpperCase(fieldValueAsString);
2122	>
2123		if (loPartialKey in Options) then
2124	<	result := result and (AnsiPos(val, fld) = 1)
2124	>	result := result and (Pos(lookupValueAsString, fieldValueAsString) = 1)
2125		else
2126	<	result := result and (val = fld);
2127	<	end else
2128	<	result := result and (val = fld);
2126	>	result := result and (fieldValueAsString = lookupValueAsString);
2127	>	end
2128	>	else
2129	>	result := result and (lookupValues[i] =
2130	>	VarAsType(fieldValue, VarType(lookupValues[i])));
2131	>	except on EVariantError do
2132	>	result := False;
2133	>	end;
2134		end;
2135		Inc(i);
2136		end;
2137		if not result then
2138	<	Next;
2138	>	Next;
2139		end;
2140		if not result then
2141		Bookmark := CurBookmark
2142		else
2143		CursorPosChanged;
2144		finally
2145	<	fl.Free;
2145	>	keyFieldList.Free;
2146	>	SetLength(lookupValues,0)
2147		end;
2148		end;
2149
#	Line 1628 | Line 2171 | begin
2171		if Assigned(FUpdateObject) then
2172		begin
2173		if (Qry = FQDelete) then
2174	<	FUpdateObject.Apply(ukDelete)
2174	>	FUpdateObject.Apply(ukDelete,Buff)
2175		else if (Qry = FQInsert) then
2176	<	FUpdateObject.Apply(ukInsert)
2176	>	FUpdateObject.Apply(ukInsert,Buff)
2177		else
2178	<	FUpdateObject.Apply(ukModify);
2178	>	FUpdateObject.Apply(ukModify,Buff);
2179		end
2180		else begin
2181		SetInternalSQLParams(Qry, Buff);
#	Line 1649 | Line 2192 | end;
2192		procedure TIBCustomDataSet.InternalRefreshRow;
2193		var
2194		Buff: PChar;
1652	–	SetCursor: Boolean;
2195		ofs: DWORD;
2196		Qry: TIBSQL;
2197		begin
2198	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1657	<	if SetCursor then
1658	<	Screen.Cursor := crHourGlass;
2198	>	FBase.SetCursor;
2199		try
2200		Buff := GetActiveBuf;
2201		if CanRefresh then
#	Line 1699 | Line 2239 | begin
2239		else
2240		IBError(ibxeCannotRefresh, [nil]);
2241		finally
2242	<	if SetCursor and (Screen.Cursor = crHourGlass) then
1703	<	Screen.Cursor := crDefault;
2242	>	FBase.RestoreCursor;
2243		end;
2244		end;
2245
#	Line 1771 | Line 2310 | end;
2310
2311		procedure TIBCustomDataSet.InternalPrepare;
2312		var
1774	–	SetCursor: Boolean;
2313		DidActivate: Boolean;
2314		begin
2315		if FInternalPrepared then
2316		Exit;
2317		DidActivate := False;
2318	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1781	<	if SetCursor then
1782	<	Screen.Cursor := crHourGlass;
2318	>	FBase.SetCursor;
2319		try
2320		ActivateConnection;
2321		DidActivate := ActivateTransaction;
2322		FBase.CheckDatabase;
2323		FBase.CheckTransaction;
2324	+	if HasParser and (FParser.SQLText <> FQSelect.SQL.Text) then
2325	+	begin
2326	+	FQSelect.OnSQLChanged := nil; {Do not react to change}
2327	+	try
2328	+	FQSelect.SQL.Text := FParser.SQLText;
2329	+	finally
2330	+	FQSelect.OnSQLChanged := SQLChanged;
2331	+	end;
2332	+	end;
2333	+	//   writeln( FQSelect.SQL.Text);
2334		if FQSelect.SQL.Text <> '' then
2335		begin
2336		if not FQSelect.Prepared then
2337		begin
2338	+	FQSelect.GenerateParamNames := FGenerateParamNames;
2339		FQSelect.ParamCheck := ParamCheck;
2340		FQSelect.Prepare;
2341		end;
2342	<	if (FQDelete.SQL.Text <> '') and (not FQDelete.Prepared) then
2342	>	FQDelete.GenerateParamNames := FGenerateParamNames;
2343	>	if (Trim(FQDelete.SQL.Text) <> '') and (not FQDelete.Prepared) then
2344		FQDelete.Prepare;
2345	<	if (FQInsert.SQL.Text <> '') and (not FQInsert.Prepared) then
2345	>	FQInsert.GenerateParamNames := FGenerateParamNames;
2346	>	if (Trim(FQInsert.SQL.Text) <> '') and (not FQInsert.Prepared) then
2347		FQInsert.Prepare;
2348	<	if (FQRefresh.SQL.Text <> '') and (not FQRefresh.Prepared) then
2348	>	FQRefresh.GenerateParamNames := FGenerateParamNames;
2349	>	if (Trim(FQRefresh.SQL.Text) <> '') and (not FQRefresh.Prepared) then
2350		FQRefresh.Prepare;
2351	<	if (FQModify.SQL.Text <> '') and (not FQModify.Prepared) then
2351	>	FQModify.GenerateParamNames := FGenerateParamNames;
2352	>	if (Trim(FQModify.SQL.Text) <> '') and (not FQModify.Prepared) then
2353		FQModify.Prepare;
2354		FInternalPrepared := True;
2355		InternalInitFieldDefs;
#	Line 1807 | Line 2358 | begin
2358		finally
2359		if DidActivate then
2360		DeactivateTransaction;
2361	<	if SetCursor and (Screen.Cursor = crHourGlass) then
1811	<	Screen.Cursor := crDefault;
2361	>	FBase.RestoreCursor;
2362		end;
2363		end;
2364
#	Line 1998 | Line 2548 | begin
2548		end;
2549		SQL_TIMESTAMP:
2550		Qry.Params[i].AsDateTime :=
2551	<	TimeStampToDateTime(
2552	<	MSecsToTimeStamp(PDouble(data)^));
2551	>	TimeStampToDateTime(MSecsToTimeStamp(trunc(PDouble(data)^)));
2552	>	SQL_BOOLEAN:
2553	>	Qry.Params[i].AsBoolean := PWordBool(data)^;
2554		end;
2555		end;
2556		end;
#	Line 2085 | Line 2636 | begin
2636		end;
2637		end;
2638
2639	+	procedure TIBCustomDataSet.RegisterIBLink(Sender: TIBControlLink);
2640	+	begin
2641	+	if FIBLinks.IndexOf(Sender) = -1 then
2642	+	FIBLinks.Add(Sender);
2643	+	end;
2644	+
2645
2646		procedure TIBCustomDataSet.SQLChanging(Sender: TObject);
2647		begin
2648	<	if FOpen then
2649	<	InternalClose;
2648	>	Active := false;
2649	>	{  if FOpen then
2650	>	InternalClose;}
2651		if FInternalPrepared then
2652		InternalUnPrepare;
2653	+	FieldDefs.Clear;
2654	+	FieldDefs.Updated := false;
2655	+	end;
2656	+
2657	+	procedure TIBCustomDataSet.SQLChanged(Sender: TObject);
2658	+	begin
2659	+	FBaseSQLSelect.assign(FQSelect.SQL);
2660		end;
2661
2662		{ I can "undelete" uninserted records (make them "inserted" again).
#	Line 2120 | Line 2685 | begin
2685		end;
2686		end;
2687
2688	+	procedure TIBCustomDataSet.UnRegisterIBLink(Sender: TIBControlLink);
2689	+	begin
2690	+	FIBLinks.Remove(Sender);
2691	+	end;
2692	+
2693		function TIBCustomDataSet.UpdateStatus: TUpdateStatus;
2694		begin
2695		if Active then
#	Line 2136 | Line 2706 | begin
2706		Result := Assigned( FQSelect ) and FQSelect.EOF;
2707		end;
2708
2709	+	function TIBCustomDataSet.ParamByName(ParamName: String): TIBXSQLVAR;
2710	+	begin
2711	+	ActivateConnection;
2712	+	ActivateTransaction;
2713	+	if not FInternalPrepared then
2714	+	InternalPrepare;
2715	+	Result := Params.ByName(ParamName);
2716	+	end;
2717	+
2718	+	{Beware: the parameter FCache is used as an identifier to determine which
2719	+	cache is being operated on and is not referenced in the computation.
2720	+	The result is an adjusted offset into the identified cache, either the
2721	+	Buffer Cache or the old Buffer Cache.}
2722	+
2723		function TIBCustomDataSet.AdjustPosition(FCache: PChar; Offset: DWORD;
2724	<	Origin: Integer): Integer;
2724	>	Origin: Integer): DWORD;
2725		var
2726		OldCacheSize: Integer;
2727		begin
#	Line 2174 | Line 2758 | procedure TIBCustomDataSet.ReadCache(FCa
2758		Buffer: PChar);
2759		var
2760		pCache: PChar;
2761	+	AdjustedOffset: DWORD;
2762		bOld: Boolean;
2763		begin
2764		bOld := (FCache = FOldBufferCache);
2765	<	pCache := PChar(AdjustPosition(FCache, Offset, Origin));
2765	>	AdjustedOffset := AdjustPosition(FCache, Offset, Origin);
2766		if not bOld then
2767	<	pCache := FBufferCache + Integer(pCache)
2767	>	pCache := FBufferCache + AdjustedOffset
2768		else
2769	<	pCache := FOldBufferCache + Integer(pCache);
2769	>	pCache := FOldBufferCache + AdjustedOffset;
2770		Move(pCache^, Buffer^, DWORD(FRecordBufferSize));
2771		AdjustPosition(FCache, FRecordBufferSize, FILE_CURRENT);
2772		end;
#	Line 2211 | Line 2796 | procedure TIBCustomDataSet.WriteCache(FC
2796		Buffer: PChar);
2797		var
2798		pCache: PChar;
2799	+	AdjustedOffset: DWORD;
2800		bOld: Boolean;
2801		dwEnd: DWORD;
2802		begin
2803		bOld := (FCache = FOldBufferCache);
2804	<	pCache := PChar(AdjustPosition(FCache, Offset, Origin));
2804	>	AdjustedOffset := AdjustPosition(FCache, Offset, Origin);
2805		if not bOld then
2806	<	pCache := FBufferCache + Integer(pCache)
2806	>	pCache := FBufferCache + AdjustedOffset
2807		else
2808	<	pCache := FOldBufferCache + Integer(pCache);
2808	>	pCache := FOldBufferCache + AdjustedOffset;
2809		Move(Buffer^, pCache^, FRecordBufferSize);
2810		dwEnd := AdjustPosition(FCache, FRecordBufferSize, FILE_CURRENT);
2811		if not bOld then
#	Line 2330 | Line 2916 | begin
2916		if FCachedUpdates and
2917		(Buff^.rdCachedUpdateStatus in [cusUnmodified]) then
2918		SaveOldBuffer(PChar(Buff));
2919	<	inherited;
2919	>	inherited DoBeforeDelete;
2920	>	end;
2921	>
2922	>	procedure TIBCustomDataSet.DoAfterDelete;
2923	>	begin
2924	>	inherited DoAfterDelete;
2925	>	FBase.DoAfterDelete(self);
2926	>	InternalAutoCommit;
2927		end;
2928
2929		procedure TIBCustomDataSet.DoBeforeEdit;
#	Line 2344 | Line 2937 | begin
2937		if FCachedUpdates and (Buff^.rdCachedUpdateStatus in [cusUnmodified, cusInserted]) then
2938		SaveOldBuffer(PChar(Buff));
2939		CopyRecordBuffer(GetActiveBuf, FOldBuffer);
2940	<	inherited;
2940	>	inherited DoBeforeEdit;
2941	>	end;
2942	>
2943	>	procedure TIBCustomDataSet.DoAfterEdit;
2944	>	begin
2945	>	inherited DoAfterEdit;
2946	>	FBase.DoAfterEdit(self);
2947		end;
2948
2949		procedure TIBCustomDataSet.DoBeforeInsert;
2950		begin
2951		if not CanInsert then
2952		IBError(ibxeCannotInsert, [nil]);
2953	<	inherited;
2953	>	inherited DoBeforeInsert;
2954	>	end;
2955	>
2956	>	procedure TIBCustomDataSet.DoAfterInsert;
2957	>	begin
2958	>	if GeneratorField.ApplyOnEvent = gaeOnNewRecord then
2959	>	GeneratorField.Apply;
2960	>	inherited DoAfterInsert;
2961	>	FBase.DoAfterInsert(self);
2962	>	end;
2963	>
2964	>	procedure TIBCustomDataSet.DoBeforeClose;
2965	>	begin
2966	>	inherited DoBeforeClose;
2967	>	if State in [dsInsert,dsEdit] then
2968	>	begin
2969	>	if FInTransactionEnd and (FCloseAction = TARollback) then
2970	>	Exit;
2971	>
2972	>	if DataSetCloseAction = dcSaveChanges then
2973	>	Post;
2974	>	{Note this can fail with an exception e.g. due to
2975	>	database validation error. In which case the dataset remains open }
2976	>	end;
2977	>	end;
2978	>
2979	>	procedure TIBCustomDataSet.DoBeforeOpen;
2980	>	var i: integer;
2981	>	begin
2982	>	if assigned(FParser) then
2983	>	FParser.Reset;
2984	>	for i := 0 to FIBLinks.Count - 1 do
2985	>	TIBControlLink(FIBLinks[i]).UpdateSQL(self);
2986	>	inherited DoBeforeOpen;
2987	>	for i := 0 to FIBLinks.Count - 1 do
2988	>	TIBControlLink(FIBLinks[i]).UpdateParams(self);
2989	>	end;
2990	>
2991	>	procedure TIBCustomDataSet.DoBeforePost;
2992	>	begin
2993	>	inherited DoBeforePost;
2994	>	if (State = dsInsert) and
2995	>	(GeneratorField.ApplyOnEvent = gaeOnPostRecord) then
2996	>	GeneratorField.Apply
2997	>	end;
2998	>
2999	>	procedure TIBCustomDataSet.DoAfterPost;
3000	>	begin
3001	>	inherited DoAfterPost;
3002	>	FBase.DoAfterPost(self);
3003	>	InternalAutoCommit;
3004		end;
3005
3006		procedure TIBCustomDataSet.FetchAll;
3007		var
3008	<	SetCursor: Boolean;
3008	>	{$IFDEF NEW_TBOOKMARK }
3009	>	CurBookmark: TBookmark;
3010	>	{$ELSE}
3011		CurBookmark: string;
3012	+	{$ENDIF}
3013		begin
3014	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3015	<	if SetCursor then
2364	<	Screen.Cursor := crHourGlass;
2365	<	try
3014	>	FBase.SetCursor;
3015	>	try
3016		if FQSelect.EOF or not FQSelect.Open then
3017		exit;
3018		DisableControls;
#	Line 2374 | Line 3024 | begin
3024		EnableControls;
3025		end;
3026		finally
3027	<	if SetCursor and (Screen.Cursor = crHourGlass) then
2378	<	Screen.Cursor := crDefault;
3027	>	FBase.RestoreCursor;
3028		end;
3029		end;
3030
#	Line 2423 | Line 3072 | begin
3072		result := FDataLink.DataSource;
3073		end;
3074
3075	+	function TIBCustomDataSet.GetDBAliasName(FieldNo: integer): string;
3076	+	begin
3077	+	Result := FAliasNameMap[FieldNo-1]
3078	+	end;
3079	+
3080	+	function TIBCustomDataSet.GetFieldDefFromAlias(aliasName: string): TFieldDef;
3081	+	var
3082	+	i: integer;
3083	+	begin
3084	+	Result := nil;
3085	+	for i := 0 to Length(FAliasNameMap) - 1 do
3086	+	if FAliasNameMap[i] = aliasName then
3087	+	begin
3088	+	Result := FieldDefs[i];
3089	+	Exit
3090	+	end;
3091	+	end;
3092	+
3093		function TIBCustomDataSet.GetFieldClass(FieldType: TFieldType): TFieldClass;
3094		begin
3095		Result := DefaultFieldClasses[FieldType];
#	Line 2441 | Line 3108 | begin
3108		result := False;
3109		Buff := GetActiveBuf;
3110		if (Buff = nil) or
3111	<	(not IsVisible(Buff)) then
3111	>	(not IsVisible(Buff)) or not assigned(Field.DataSet) then
3112		exit;
3113		{ The intention here is to stuff the buffer with the data for the
3114		referenced field for the current record }
#	Line 2463 | Line 3130 | begin
3130		Data := Buff + CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs;
3131		if (fdDataType = SQL_VARYING) or (fdDataType = SQL_TEXT) then
3132		begin
3133	<	Move(Data^, Buffer^, fdDataLength);
3134	<	PChar(Buffer)[fdDataLength] := #0;
3133	>	if fdDataLength < Field.DataSize then
3134	>	begin
3135	>	Move(Data^, Buffer^, fdDataLength);
3136	>	PChar(Buffer)[fdDataLength] := #0;
3137	>	end
3138	>	else
3139	>	IBError(ibxeFieldSizeError,[Field.FieldName])
3140		end
3141		else
3142		Move(Data^, Buffer^, Field.DataSize);
#	Line 2507 | Line 3179 | begin
3179		if not Accept and (GetMode = gmCurrent) then
3180		GetMode := gmPrior;
3181		except
3182	<	//        Application.HandleException(Self);
3182	>	//        FBase.HandleException(Self);
3183		end;
3184		end;
3185		RestoreState(SaveState);
#	Line 2601 | Line 3273 | begin
3273		result := FRecordBufferSize;
3274		end;
3275
3276	+	procedure TIBCustomDataSet.InternalAutoCommit;
3277	+	begin
3278	+	with Transaction do
3279	+	if InTransaction and (FAutoCommit = acCommitRetaining) then
3280	+	begin
3281	+	if CachedUpdates then ApplyUpdates;
3282	+	CommitRetaining;
3283	+	end;
3284	+	end;
3285	+
3286		procedure TIBCustomDataSet.InternalAddRecord(Buffer: Pointer; Append: Boolean);
3287		begin
3288		CheckEditState;
#	Line 2629 | Line 3311 | var
3311		Buff: PChar;
3312		CurRec: Integer;
3313		begin
3314	<	inherited;
3314	>	inherited InternalCancel;
3315		Buff := GetActiveBuf;
3316		if Buff <> nil then begin
3317		CurRec := FCurrentRecord;
#	Line 2672 | Line 3354 | begin
3354		FreeMem(FOldBufferCache);
3355		FOldBufferCache := nil;
3356		BindFields(False);
3357	+	ResetParser;
3358		if DefaultFields then DestroyFields;
3359		end;
3360
3361		procedure TIBCustomDataSet.InternalDelete;
3362		var
3363		Buff: PChar;
2681	–	SetCursor: Boolean;
3364		begin
3365	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
2684	<	if SetCursor then
2685	<	Screen.Cursor := crHourGlass;
3365	>	FBase.SetCursor;
3366		try
3367		Buff := GetActiveBuf;
3368		if CanDelete then
#	Line 2707 | Line 3387 | begin
3387		end else
3388		IBError(ibxeCannotDelete, [nil]);
3389		finally
3390	<	if SetCursor and (Screen.Cursor = crHourGlass) then
2711	<	Screen.Cursor := crDefault;
3390	>	FBase.RestoreCursor;
3391		end;
3392		end;
3393
#	Line 2724 | Line 3403 | end;
3403
3404		procedure TIBCustomDataSet.InternalHandleException;
3405		begin
3406	<	Application.HandleException(Self)
3406	>	FBase.HandleException(Self)
3407		end;
3408
3409		procedure TIBCustomDataSet.InternalInitFieldDefs;
3410	+	begin
3411	+	if not InternalPrepared then
3412	+	begin
3413	+	InternalPrepare;
3414	+	exit;
3415	+	end;
3416	+	FieldDefsFromQuery(FQSelect);
3417	+	end;
3418	+
3419	+	procedure TIBCustomDataSet.FieldDefsFromQuery(SourceQuery: TIBSQL);
3420		const
3421		DefaultSQL = 'Select F.RDB$COMPUTED_BLR, ' + {do not localize}
3422		'F.RDB$DEFAULT_VALUE, R.RDB$FIELD_NAME ' + {do not localize}
#	Line 2739 | Line 3428 | const
3428		var
3429		FieldType: TFieldType;
3430		FieldSize: Word;
3431	+	charSetID: short;
3432	+	CharSetSize: integer;
3433	+	CharSetName: RawByteString;
3434	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3435	+	FieldCodePage: TSystemCodePage;
3436	+	{$ENDIF}
3437		FieldNullable : Boolean;
3438		i, FieldPosition, FieldPrecision: Integer;
3439	<	FieldAliasName: string;
3439	>	FieldAliasName, DBAliasName: string;
3440		RelationName, FieldName: string;
3441		Query : TIBSQL;
3442		FieldIndex: Integer;
#	Line 2841 | Line 3536 | var
3536		end;
3537
3538		begin
2844	–	if not InternalPrepared then
2845	–	begin
2846	–	InternalPrepare;
2847	–	exit;
2848	–	end;
3539		FRelationNodes := TRelationNode.Create;
3540		FNeedsRefresh := False;
3541		Database.InternalTransaction.StartTransaction;
#	Line 2856 | Line 3546 | begin
3546		FieldDefs.BeginUpdate;
3547		FieldDefs.Clear;
3548		FieldIndex := 0;
3549	<	if (Length(FMappedFieldPosition) < FQSelect.Current.Count) then
3550	<	SetLength(FMappedFieldPosition, FQSelect.Current.Count);
3549	>	if (Length(FMappedFieldPosition) < SourceQuery.Current.Count) then
3550	>	SetLength(FMappedFieldPosition, SourceQuery.Current.Count);
3551		Query.SQL.Text := DefaultSQL;
3552		Query.Prepare;
3553	<	for i := 0 to FQSelect.Current.Count - 1 do
3554	<	with FQSelect.Current[i].Data^ do
3553	>	SetLength(FAliasNameMap, SourceQuery.Current.Count);
3554	>	SetLength(FAliasNameList, SourceQuery.Current.Count);
3555	>	for i := 0 to SourceQuery.Current.Count - 1 do
3556	>	with SourceQuery.Current[i].Data^ do
3557		begin
3558		{ Get the field name }
3559	<	SetString(FieldAliasName, aliasname, aliasname_length);
3559	>	FieldAliasName := SourceQuery.Current[i].Name;
3560	>	SetString(DBAliasName, aliasname, aliasname_length);
3561		SetString(RelationName, relname, relname_length);
3562		SetString(FieldName, sqlname, sqlname_length);
3563	+	FAliasNameList[i] := DBAliasName;
3564		FieldSize := 0;
3565		FieldPrecision := 0;
3566	<	FieldNullable := FQSelect.Current[i].IsNullable;
3566	>	FieldNullable := SourceQuery.Current[i].IsNullable;
3567	>	CharSetSize := 0;
3568	>	CharSetName := '';
3569	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3570	>	FieldCodePage := CP_NONE;
3571	>	{$ENDIF}
3572		case sqltype and not 1 of
3573		{ All VARCHAR's must be converted to strings before recording
3574		their values }
3575		SQL_VARYING, SQL_TEXT:
3576		begin
3577	+	CharSetSize := FBase.GetCharSetSize(sqlsubtype and $FF);
3578	+	CharSetName := FBase.GetCharSetName(sqlsubtype and $FF);
3579	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3580	+	FieldCodePage := FBase.GetCodePage(sqlsubtype and $FF);
3581	+	{$ENDIF}
3582	+	{FieldSize is encoded for strings - see TIBStringField.SetSize for decode}
3583		FieldSize := sqllen;
3584	<	FieldType := ftString;
3584	>	if CharSetSize = 2 then
3585	>	FieldType := ftWideString
3586	>	else
3587	>	FieldType := ftString;
3588		end;
3589		{ All Doubles/Floats should be cast to doubles }
3590		SQL_DOUBLE, SQL_FLOAT:
#	Line 2902 | Line 3610 | begin
3610		FieldSize := -sqlscale;
3611		end
3612		else
3613	<	FieldType := ftFloat;
3613	>	if Database.SQLDialect = 1 then
3614	>	FieldType := ftFloat
3615	>	else
3616	>	if (FieldCount > i) and (Fields[i] is TFloatField) then
3617	>	FieldType := ftFloat
3618	>	else
3619	>	begin
3620	>	FieldType := ftFMTBCD;
3621	>	FieldPrecision := 9;
3622	>	FieldSize := -sqlscale;
3623		end;
3624	+	end;
3625	+
3626		SQL_INT64:
3627		begin
3628		if (sqlscale = 0) then
#	Line 2915 | Line 3634 | begin
3634		FieldSize := -sqlscale;
3635		end
3636		else
3637	<	FieldType := ftFloat;
3638	<	end;
3637	>	FieldType := ftFloat
3638	>	end;
3639		SQL_TIMESTAMP: FieldType := ftDateTime;
3640		SQL_TYPE_TIME: FieldType := ftTime;
3641		SQL_TYPE_DATE: FieldType := ftDate;
#	Line 2924 | Line 3643 | begin
3643		begin
3644		FieldSize := sizeof (TISC_QUAD);
3645		if (sqlsubtype = 1) then
3646	<	FieldType := ftmemo
3646	>	begin
3647	>	if FBase.GetDefaultCharSetName <> '' then
3648	>	begin
3649	>	CharSetSize := FBase.GetDefaultCharSetSize;
3650	>	CharSetName := FBase.GetDefaultCharSetName;
3651	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3652	>	FieldCodePage := FBase.GetDefaultCodePage;
3653	>	{$ENDIF}
3654	>	end
3655	>	else
3656	>	if strpas(sqlname) <> '' then
3657	>	begin
3658	>	charSetID := GetBlobCharSetID(Database.Handle,Database.InternalTransaction.Handle,
3659	>	@relname,@sqlname);
3660	>	CharSetSize := FBase.GetCharSetSize(charSetID);
3661	>	CharSetName := FBase.GetCharSetName(charSetID);
3662	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3663	>	FieldCodePage := FBase.GetCodePage(charSetID);
3664	>	{$ENDIF}
3665	>	end
3666	>	else  {Complex SQL with no identifiable column and no connection default}
3667	>	begin
3668	>	CharSetName := '';
3669	>	CharSetSize := 1;
3670	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3671	>	FieldCodePage := CP_NONE;
3672	>	{$ENDIF}
3673	>	end;
3674	>	if CharSetSize = 2 then
3675	>	FieldType := ftWideMemo
3676	>	else
3677	>	FieldType := ftMemo;
3678	>	end
3679		else
3680		FieldType := ftBlob;
3681		end;
#	Line 2933 | Line 3684 | begin
3684		FieldSize := sizeof (TISC_QUAD);
3685		FieldType := ftUnknown;
3686		end;
3687	+	SQL_BOOLEAN:
3688	+	FieldType:= ftBoolean;
3689		else
3690		FieldType := ftUnknown;
3691		end;
#	Line 2941 | Line 3694 | begin
3694		begin
3695		FMappedFieldPosition[FieldIndex] := FieldPosition;
3696		Inc(FieldIndex);
3697	<	with FieldDefs.AddFieldDef do
3697	>	with TIBFieldDef.Create(FieldDefs,'',FieldType,0,False,FieldDefs.Count+1) do
3698		begin
3699	<	Name := string( FieldAliasName );
3700	<	FieldNo := FieldPosition;
2948	<	DataType := FieldType;
3699	>	Name := FieldAliasName;
3700	>	FAliasNameMap[FieldNo-1] := DBAliasName;
3701		Size := FieldSize;
3702		Precision := FieldPrecision;
3703	<	Required := False;
3703	>	Required := not FieldNullable;
3704		InternalCalcField := False;
3705	+	CharacterSetSize := CharSetSize;
3706	+	CharacterSetName := CharSetName;
3707	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3708	+	CodePage := FieldCodePage;
3709	+	{$ENDIF}
3710		if (FieldName <> '') and (RelationName <> '') then
3711		begin
3712		if Has_COMPUTED_BLR(RelationName, FieldName) then
#	Line 3029 | Line 3786 | begin
3786		else case cur_field.DataType of
3787		ftString:
3788		cur_param.AsString := cur_field.AsString;
3789	<	ftBoolean, ftSmallint, ftWord:
3789	>	ftBoolean:
3790	>	cur_param.AsBoolean := cur_field.AsBoolean;
3791	>	ftSmallint, ftWord:
3792		cur_param.AsShort := cur_field.AsInteger;
3793		ftInteger:
3794		cur_param.AsLong := cur_field.AsInteger;
#	Line 3082 | Line 3841 | begin
3841		end;
3842
3843		procedure TIBCustomDataSet.InternalOpen;
3085	–	var
3086	–	SetCursor: Boolean;
3844
3845		function RecordDataLength(n: Integer): Long;
3846		begin
3847		result := SizeOf(TRecordData) + ((n - 1) * SizeOf(TFieldData));
3848		end;
3849
3850	+	function GetFieldDef(aFieldNo: integer): TIBFieldDef;
3851	+	var i: integer;
3852	+	begin
3853	+	Result := nil;
3854	+	for i := 0 to FieldDefs.Count - 1 do
3855	+	if FieldDefs[i].FieldNo = aFieldNo then
3856	+	begin
3857	+	Result := TIBFieldDef(FieldDefs[i]);
3858	+	break;
3859	+	end;
3860	+	end;
3861	+
3862	+	procedure SetExtendedProperties;
3863	+	var i: integer;
3864	+	IBFieldDef: TIBFieldDef;
3865	+	begin
3866	+	for i := 0 to Fields.Count - 1 do
3867	+	if Fields[i].FieldNo > 0 then
3868	+	begin
3869	+	if(Fields[i] is TIBStringField) then
3870	+	with TIBStringField(Fields[i]) do
3871	+	begin
3872	+	IBFieldDef := GetFieldDef(FieldNo);
3873	+	if IBFieldDef <> nil then
3874	+	begin
3875	+	CharacterSetSize := IBFieldDef.CharacterSetSize;
3876	+	CharacterSetName := IBFieldDef.CharacterSetName;
3877	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3878	+	CodePage := IBFieldDef.CodePage;
3879	+	{$ENDIF}
3880	+	end;
3881	+	end
3882	+	else
3883	+	if(Fields[i] is TIBWideStringField) then
3884	+	with TIBWideStringField(Fields[i]) do
3885	+	begin
3886	+	IBFieldDef := GetFieldDef(FieldNo);
3887	+	if IBFieldDef <> nil then
3888	+	begin
3889	+	CharacterSetSize := IBFieldDef.CharacterSetSize;
3890	+	CharacterSetName := IBFieldDef.CharacterSetName;
3891	+	end;
3892	+	end
3893	+	else
3894	+	if(Fields[i] is TIBMemoField) then
3895	+	with TIBMemoField(Fields[i]) do
3896	+	begin
3897	+	IBFieldDef := GetFieldDef(FieldNo);
3898	+	if IBFieldDef <> nil then
3899	+	begin
3900	+	CharacterSetSize := IBFieldDef.CharacterSetSize;
3901	+	CharacterSetName := IBFieldDef.CharacterSetName;
3902	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3903	+	CodePage := IBFieldDef.CodePage;
3904	+	{$ENDIF}
3905	+	end;
3906	+	end
3907	+	else
3908	+	if(Fields[i] is TIBWideMemoField) then
3909	+	with TIBWideMemoField(Fields[i]) do
3910	+	begin
3911	+	IBFieldDef := GetFieldDef(FieldNo);
3912	+	if IBFieldDef <> nil then
3913	+	begin
3914	+	CharacterSetSize := IBFieldDef.CharacterSetSize;
3915	+	CharacterSetName := IBFieldDef.CharacterSetName;
3916	+	end;
3917	+	end
3918	+	end
3919	+	end;
3920	+
3921		begin
3922	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3095	<	if SetCursor then
3096	<	Screen.Cursor := crHourGlass;
3922	>	FBase.SetCursor;
3923		try
3924		ActivateConnection;
3925		ActivateTransaction;
#	Line 3106 | Line 3932 | begin
3932		if DefaultFields then
3933		CreateFields;
3934		BindFields(True);
3935	+	SetExtendedProperties;
3936		FCurrentRecord := -1;
3937		FQSelect.ExecQuery;
3938		FOpen := FQSelect.Open;
#	Line 3154 | Line 3981 | begin
3981		else
3982		FQSelect.ExecQuery;
3983		finally
3984	<	if SetCursor and (Screen.Cursor = crHourGlass) then
3158	<	Screen.Cursor := crDefault;
3984	>	FBase.RestoreCursor;
3985		end;
3986		end;
3987
#	Line 3163 | Line 3989 | procedure TIBCustomDataSet.InternalPost;
3989		var
3990		Qry: TIBSQL;
3991		Buff: PChar;
3166	–	SetCursor: Boolean;
3992		bInserting: Boolean;
3993		begin
3994	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3170	<	if SetCursor then
3171	<	Screen.Cursor := crHourGlass;
3994	>	FBase.SetCursor;
3995		try
3996		Buff := GetActiveBuf;
3997		CheckEditState;
#	Line 3206 | Line 4029 | begin
4029		if bInserting then
4030		Inc(FRecordCount);
4031		finally
4032	<	if SetCursor and (Screen.Cursor = crHourGlass) then
3210	<	Screen.Cursor := crDefault;
4032	>	FBase.RestoreCursor;
4033		end;
4034		end;
4035
4036		procedure TIBCustomDataSet.InternalRefresh;
4037		begin
4038	<	inherited;
4038	>	inherited InternalRefresh;
4039		InternalRefreshRow;
4040		end;
4041
#	Line 3227 | Line 4049 | begin
4049		result := FOpen;
4050		end;
4051
4052	+	procedure TIBCustomDataSet.Loaded;
4053	+	begin
4054	+	if assigned(FQSelect) then
4055	+	FBaseSQLSelect.assign(FQSelect.SQL);
4056	+	inherited Loaded;
4057	+	end;
4058	+
4059	+	procedure TIBCustomDataSet.Post;
4060	+	var CancelPost: boolean;
4061	+	begin
4062	+	CancelPost := false;
4063	+	if assigned(FOnValidatePost) then
4064	+	OnValidatePost(self,CancelPost);
4065	+	if CancelPost then
4066	+	Cancel
4067	+	else
4068	+	inherited Post;
4069	+	end;
4070	+
4071		function TIBCustomDataSet.Locate(const KeyFields: string; const KeyValues: Variant;
4072		Options: TLocateOptions): Boolean;
4073		var
4074	+	{$IFDEF NEW_TBOOKMARK }
4075	+	CurBookmark: TBookmark;
4076	+	{$ELSE}
4077		CurBookmark: string;
4078	+	{$ENDIF}
4079		begin
4080		DisableControls;
4081		try
#	Line 3248 | Line 4093 | function TIBCustomDataSet.Lookup(const K
4093		const ResultFields: string): Variant;
4094		var
4095		fl: TList;
4096	+	{$IFDEF NEW_TBOOKMARK }
4097	+	CurBookmark: TBookmark;
4098	+	{$ELSE}
4099		CurBookmark: string;
4100	+	{$ENDIF}
4101		begin
4102		DisableControls;
4103		fl := TList.Create;
#	Line 3301 | Line 4150 | end;
4150		procedure TIBCustomDataSet.InternalSetFieldData(Field: TField; Buffer: Pointer);
4151		var
4152		Buff, TmpBuff: PChar;
4153	+	MappedFieldPos: integer;
4154		begin
4155		Buff := GetActiveBuf;
4156		if Field.FieldNo < 0 then
#	Line 3317 | Line 4167 | begin
4167		begin
4168		{ If inserting, Adjust record position }
4169		AdjustRecordOnInsert(Buff);
4170	<	if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and
4171	<	(FMappedFieldPosition[Field.FieldNo - 1] <= rdFieldCount) then
4170	>	MappedFieldPos := FMappedFieldPosition[Field.FieldNo - 1];
4171	>	if (MappedFieldPos > 0) and
4172	>	(MappedFieldPos <= rdFieldCount) then
4173		begin
4174		Field.Validate(Buffer);
4175		if (Buffer = nil) or
4176		(Field is TIBStringField) and (PChar(Buffer)[0] = #0) then
4177	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull := True
4177	>	rdFields[MappedFieldPos].fdIsNull := True
4178		else begin
4179	<	Move(Buffer^, Buff[rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs],
4180	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataSize);
4181	<	if (rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_TEXT) or
4182	<	(rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_VARYING) then
4183	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataLength := StrLen(PChar(Buffer));
4184	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull := False;
4179	>	Move(Buffer^, Buff[rdFields[MappedFieldPos].fdDataOfs],
4180	>	rdFields[MappedFieldPos].fdDataSize);
4181	>	if (rdFields[MappedFieldPos].fdDataType = SQL_TEXT) or
4182	>	(rdFields[MappedFieldPos].fdDataType = SQL_VARYING) then
4183	>	rdFields[MappedFieldPos].fdDataLength := StrLen(PChar(Buffer));
4184	>	rdFields[MappedFieldPos].fdIsNull := False;
4185		if rdUpdateStatus = usUnmodified then
4186		begin
4187		if CachedUpdates then
#	Line 3354 | Line 4205 | begin
4205		end;
4206		end;
4207		if not (State in [dsCalcFields, dsFilter, dsNewValue]) then
4208	<	DataEvent(deFieldChange, Longint(Field));
4208	>	DataEvent(deFieldChange, PtrInt(Field));
4209		end;
4210
4211		procedure TIBCustomDataSet.SetRecNo(Value: Integer);
#	Line 3418 | Line 4269 | begin
4269		FillChar(Buffer[FRecordSize], CalcFieldsSize, 0);
4270		end;
4271
4272	+	procedure TIBCustomDataSet.ClearIBLinks;
4273	+	var i: integer;
4274	+	begin
4275	+	for i := FIBLinks.Count - 1 downto 0 do
4276	+	TIBControlLink(FIBLinks[i]).IBDataSet := nil;
4277	+	end;
4278	+
4279
4280		procedure TIBCustomDataSet.InternalUnPrepare;
4281		begin
#	Line 3425 | Line 4283 | begin
4283		begin
4284		CheckDatasetClosed;
4285		FieldDefs.Clear;
4286	+	FieldDefs.Updated := false;
4287		FInternalPrepared := False;
4288	+	Setlength(FAliasNameList,0);
4289		end;
4290		end;
4291
4292		procedure TIBCustomDataSet.InternalExecQuery;
4293		var
4294		DidActivate: Boolean;
3435	–	SetCursor: Boolean;
4295		begin
4296		DidActivate := False;
4297	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3439	<	if SetCursor then
3440	<	Screen.Cursor := crHourGlass;
4297	>	FBase.SetCursor;
4298		try
4299		ActivateConnection;
4300		DidActivate := ActivateTransaction;
#	Line 3454 | Line 4311 | begin
4311		finally
4312		if DidActivate then
4313		DeactivateTransaction;
4314	<	if SetCursor and (Screen.Cursor = crHourGlass) then
3458	<	Screen.Cursor := crDefault;
4314	>	FBase.RestoreCursor;
4315		end;
4316		end;
4317
#	Line 3464 | Line 4320 | begin
4320		Result := FQSelect.Handle;
4321		end;
4322
4323	+	function TIBCustomDataSet.GetParser: TSelectSQLParser;
4324	+	begin
4325	+	if not assigned(FParser) then
4326	+	FParser := CreateParser;
4327	+	Result := FParser
4328	+	end;
4329	+
4330	+	procedure TIBCustomDataSet.ResetParser;
4331	+	begin
4332	+	if assigned(FParser) then
4333	+	begin
4334	+	FParser.Free;
4335	+	FParser := nil;
4336	+	FQSelect.OnSQLChanged := nil; {Do not react to change}
4337	+	try
4338	+	FQSelect.SQL.Assign(FBaseSQLSelect);
4339	+	finally
4340	+	FQSelect.OnSQLChanged := SQLChanged;
4341	+	end;
4342	+	end;
4343	+	end;
4344	+
4345	+	function TIBCustomDataSet.HasParser: boolean;
4346	+	begin
4347	+	Result := not (csDesigning in ComponentState) and (FParser <> nil)
4348	+	end;
4349	+
4350	+	procedure TIBCustomDataSet.SetGenerateParamNames(AValue: Boolean);
4351	+	begin
4352	+	if FGenerateParamNames = AValue then Exit;
4353	+	FGenerateParamNames := AValue;
4354	+	Disconnect
4355	+	end;
4356	+
4357		procedure TIBCustomDataSet.InitRecord(Buffer: PChar);
4358		begin
4359		inherited InitRecord(Buffer);
#	Line 3482 | Line 4372 | end;
4372
4373		{ TIBDataSet IProviderSupport }
4374
4375	<	procedure TIBCustomDataSet.PSEndTransaction(Commit: Boolean);
4375	>	(*procedure TIBCustomDataSet.PSEndTransaction(Commit: Boolean);
4376		begin
4377		if Commit then
4378		Transaction.Commit else
#	Line 3645 | Line 4535 | begin
4535		if not FQSelect.Prepared then
4536		FQSelect.Prepare;
4537		Result := FQSelect.UniqueRelationName;
4538	<	end;
4538	>	end;*)
4539
4540		procedure TIBDataSet.BatchInput(InputObject: TIBBatchInput);
4541		begin
#	Line 3682 | Line 4572 | begin
4572		ActivateConnection;
4573		ActivateTransaction;
4574		InternalSetParamsFromCursor;
4575	<	Inherited;
4575	>	Inherited InternalOpen;
4576		end;
4577
4578		procedure TIBDataSet.SetFiltered(Value: Boolean);
#	Line 3710 | Line 4600 | end;
4600
4601		function TIBCustomDataSet.GetFieldData(Field: TField;
4602		Buffer: Pointer): Boolean;
4603	+	{$IFDEF TBCDFIELD_IS_BCD}
4604		var
4605		lTempCurr : System.Currency;
4606		begin
#	Line 3720 | Line 4611 | begin
4611		CurrToBCD(lTempCurr, TBCD(Buffer^), 32, Field.Size);
4612		end
4613		else
4614	+	{$ELSE}
4615	+	begin
4616	+	{$ENDIF}
4617		Result := InternalGetFieldData(Field, Buffer);
4618		end;
4619
#	Line 3733 | Line 4627 | begin
4627		end;
4628
4629		procedure TIBCustomDataSet.SetFieldData(Field: TField; Buffer: Pointer);
4630	+	{$IFDEF TDBDFIELD_IS_BCD}
4631		var
4632		lTempCurr : System.Currency;
4633		begin
4634	<	if Field.DataType = ftBCD then
4634	>	if (Field.DataType = ftBCD) and (Buffer <> nil) then
4635		begin
4636		BCDToCurr(TBCD(Buffer^), lTempCurr);
4637		InternalSetFieldData(Field, @lTempCurr);
4638		end
4639		else
4640	+	{$ELSE}
4641	+	begin
4642	+	{$ENDIF}
4643		InternalSetFieldData(Field, Buffer);
4644		end;
4645
#	Line 3765 | Line 4663 | end;
4663		destructor TIBDataSetUpdateObject.Destroy;
4664		begin
4665		FRefreshSQL.Free;
4666	<	inherited destroy;
4666	>	inherited Destroy;
4667		end;
4668
4669		procedure TIBDataSetUpdateObject.SetRefreshSQL(Value: TStrings);
#	Line 3773 | Line 4671 | begin
4671		FRefreshSQL.Assign(Value);
4672		end;
4673
4674	+	procedure TIBDataSetUpdateObject.InternalSetParams(Query: TIBSQL; buff: PChar);
4675	+	begin
4676	+	if not Assigned(DataSet) then Exit;
4677	+	DataSet.SetInternalSQLParams(Query, buff);
4678	+	end;
4679	+
4680		{ TIBDSBlobStream }
4681		constructor TIBDSBlobStream.Create(AField: TField; ABlobStream: TIBBlobStream;
4682		Mode: TBlobStreamMode);
#	Line 3784 | Line 4688 | begin
4688		FBlobStream.Truncate;
4689		end;
4690
4691	+	destructor TIBDSBlobStream.Destroy;
4692	+	begin
4693	+	if FHasWritten then
4694	+	TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
4695	+	inherited Destroy;
4696	+	end;
4697	+
4698		function TIBDSBlobStream.Read(var Buffer; Count: Longint): Longint;
4699		begin
4700		result := FBlobStream.Read(Buffer, Count);
#	Line 3804 | Line 4715 | begin
4715		if not (FField.DataSet.State in [dsEdit, dsInsert]) then
4716		IBError(ibxeNotEditing, [nil]);
4717		TIBCustomDataSet(FField.DataSet).RecordModified(True);
4718	+	TBlobField(FField).Modified := true;
4719		result := FBlobStream.Write(Buffer, Count);
4720	<	TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, Longint(FField));
4720	>	FHasWritten := true;
4721	>	{  TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
4722	>	Removed as this caused a seek to beginning of the blob stream thus corrupting
4723	>	the blob stream. Moved to the destructor i.e. called after blob written}
4724	>	end;
4725	>
4726	>	{ TIBGenerator }
4727	>
4728	>	procedure TIBGenerator.SetIncrement(const AValue: integer);
4729	>	begin
4730	>	if AValue < 0 then
4731	>	raise Exception.Create('A Generator Increment cannot be negative');
4732	>	FIncrement := AValue
4733	>	end;
4734	>
4735	>	function TIBGenerator.GetNextValue(ADatabase: TIBDatabase;
4736	>	ATransaction: TIBTransaction): integer;
4737	>	begin
4738	>	with TIBSQL.Create(nil) do
4739	>	try
4740	>	Database := ADatabase;
4741	>	Transaction := ATransaction;
4742	>	if not assigned(Database) then
4743	>	IBError(ibxeCannotSetDatabase,[]);
4744	>	if not assigned(Transaction) then
4745	>	IBError(ibxeCannotSetTransaction,[]);
4746	>	with Transaction do
4747	>	if not InTransaction then StartTransaction;
4748	>	SQL.Text := Format('Select Gen_ID(%s,%d) as ID From RDB$Database',[FGeneratorName,Increment]);
4749	>	Prepare;
4750	>	ExecQuery;
4751	>	try
4752	>	Result := FieldByName('ID').AsInteger
4753	>	finally
4754	>	Close
4755	>	end;
4756	>	finally
4757	>	Free
4758	>	end;
4759	>	end;
4760	>
4761	>	constructor TIBGenerator.Create(Owner: TIBCustomDataSet);
4762	>	begin
4763	>	FOwner := Owner;
4764	>	FIncrement := 1;
4765		end;
4766
4767	+
4768	+	procedure TIBGenerator.Apply;
4769	+	begin
4770	+	if (FGeneratorName <> '') and (FFieldName <> '') and Owner.FieldByName(FFieldName).IsNull then
4771	+	Owner.FieldByName(FFieldName).AsInteger := GetNextValue(Owner.Database,Owner.Transaction);
4772	+	end;
4773	+
4774	+
4775		end.

Diff Legend

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