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 41 by tony, Sat Jul 16 12:25:48 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	+	function  GetSize: Int64; override;
744		public
745		constructor Create(AField: TField; ABlobStream: TIBBlobStream;
746		Mode: TBlobStreamMode);
747	+	destructor Destroy; override;
748		function Read(var Buffer; Count: Longint): Longint; override;
749		function Seek(Offset: Longint; Origin: Word): Longint; override;
750		procedure SetSize(NewSize: Longint); override;
#	Line 568 | Line 769 | DefaultFieldClasses: array[TFieldType] o
769		TVarBytesField,     { ftVarBytes }
770		TAutoIncField,      { ftAutoInc }
771		TBlobField,         { ftBlob }
772	<	TMemoField,         { ftMemo }
772	>	TIBMemoField,       { ftMemo }
773		TGraphicField,      { ftGraphic }
774		TBlobField,         { ftFmtMemo }
775		TBlobField,         { ftParadoxOle }
#	Line 576 | Line 777 | DefaultFieldClasses: array[TFieldType] o
777		TBlobField,         { ftTypedBinary }
778		nil,                { ftCursor }
779		TStringField,       { ftFixedChar }
780	<	nil, {TWideStringField } { ftWideString }
780	>	TIBWideStringField,    { ftWideString }
781		TLargeIntField,     { ftLargeInt }
782	+	nil,          { ftADT }
783	+	nil,        { ftArray }
784	+	nil,    { ftReference }
785	+	nil,     { ftDataSet }
786	+	TBlobField,         { ftOraBlob }
787	+	TMemoField,         { ftOraClob }
788	+	TVariantField,      { ftVariant }
789	+	nil,    { ftInterface }
790	+	nil,     { ftIDispatch }
791	+	TGuidField,        { ftGuid }
792	+	TDateTimeField,    {ftTimestamp}
793	+	TIBBCDField,       {ftFMTBcd}
794	+	nil,  {ftFixedWideChar}
795	+	TIBWideMemoField);   {ftWideMemo}
796	+	(*
797		TADTField,          { ftADT }
798		TArrayField,        { ftArray }
799		TReferenceField,    { ftReference }
#	Line 587 | Line 803 | DefaultFieldClasses: array[TFieldType] o
803		TVariantField,      { ftVariant }
804		TInterfaceField,    { ftInterface }
805		TIDispatchField,     { ftIDispatch }
806	<	TGuidField);        { ftGuid }
807	<	var
808	<	CreateProviderProc: function(DataSet: TIBCustomDataSet): IProvider = nil;
806	>	TGuidField);        { ftGuid } *)
807	>	(*var
808	>	CreateProviderProc: function(DataSet: TIBCustomDataSet): IProvider = nil;*)
809
810		implementation
811
812	<	uses IBIntf, IBQuery;
812	>	uses IBIntf, Variants, FmtBCD, LazUTF8;
813	>
814	>	const FILE_BEGIN = 0;
815	>	FILE_CURRENT = 1;
816	>	FILE_END = 2;
817
818		type
819
#	Line 612 | Line 832 | type
832		NextRelation : TRelationNode;
833		end;
834
835	+	{Extended Field Def for character set info}
836	+
837	+	{ TIBFieldDef }
838	+
839	+	TIBFieldDef = class(TFieldDef)
840	+	private
841	+	FCharacterSetName: RawByteString;
842	+	FCharacterSetSize: integer;
843	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
844	+	FCodePage: TSystemCodePage;
845	+	{$ENDIF}
846	+	published
847	+	property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
848	+	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
849	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
850	+	property CodePage: TSystemCodePage read FCodePage write FCodePage;
851	+	{$ENDIF}
852	+	end;
853	+
854	+
855	+	{  Copied from LCLProc in order to avoid LCL dependency
856	+
857	+	Ensures the covenient look of multiline string
858	+	when displaying it in the single line
859	+	* Replaces CR and LF with spaces
860	+	* Removes duplicate spaces
861	+	}
862	+	function TextToSingleLine(const AText: string): string;
863	+	var
864	+	str: string;
865	+	i, wstart, wlen: Integer;
866	+	begin
867	+	str := Trim(AText);
868	+	wstart := 0;
869	+	wlen := 0;
870	+	i := 1;
871	+	while i < Length(str) - 1 do
872	+	begin
873	+	if (str[i] in [' ', #13, #10]) then
874	+	begin
875	+	if (wstart = 0) then
876	+	begin
877	+	wstart := i;
878	+	wlen := 1;
879	+	end else
880	+	Inc(wlen);
881	+	end else
882	+	begin
883	+	if wstart > 0 then
884	+	begin
885	+	str[wstart] := ' ';
886	+	Delete(str, wstart+1, wlen-1);
887	+	Dec(i, wlen-1);
888	+	wstart := 0;
889	+	end;
890	+	end;
891	+	Inc(i);
892	+	end;
893	+	Result := str;
894	+	end;
895	+
896	+	{ TIBWideMemoField }
897	+
898	+	function TIBWideMemoField.GetTruncatedText: string;
899	+	begin
900	+	Result := GetAsString;
901	+
902	+	if Result <> '' then
903	+	if DisplayWidth = 0 then
904	+	Result := TextToSingleLine(Result)
905	+	else
906	+	if Length(Result) > DisplayWidth then {Show truncation with elipses}
907	+	Result := TextToSingleLine(system.copy(Result,1,DisplayWidth-3)) + '...';
908	+	end;
909	+
910	+	function TIBWideMemoField.GetDefaultWidth: Longint;
911	+	begin
912	+	Result := 128;
913	+	end;
914	+
915	+	procedure TIBWideMemoField.GetText(var AText: string; ADisplayText: Boolean);
916	+	begin
917	+	if ADisplayText then
918	+	begin
919	+	if not DisplayTextAsClassName and (CharacterSetName<> '') then
920	+	AText := GetTruncatedText
921	+	else
922	+	inherited GetText(AText, ADisplayText);
923	+	end
924	+	else
925	+	AText := GetAsString;
926	+	end;
927	+
928	+	constructor TIBWideMemoField.Create(AOwner: TComponent);
929	+	begin
930	+	inherited Create(AOwner);
931	+	BlobType := ftWideMemo;
932	+	end;
933	+
934	+	{ TIBMemoField }
935	+
936	+	function TIBMemoField.GetTruncatedText: string;
937	+	begin
938	+	Result := GetAsString;
939	+
940	+	if Result <> '' then
941	+	begin
942	+	case CharacterSetSize of
943	+	1:
944	+	if DisplayWidth = 0 then
945	+	Result := TextToSingleLine(Result)
946	+	else
947	+	if Length(Result) > DisplayWidth then {Show truncation with elipses}
948	+	Result := TextToSingleLine(system.copy(Result,1,DisplayWidth-3)) + '...';
949	+
950	+	{2: case 2 ignored. This should be handled by TIBWideMemo}
951	+
952	+	3, {Assume UNICODE_FSS is really UTF8}
953	+	4: {Include GB18030 - assuming UTF8 routine work for this codeset}
954	+	if DisplayWidth = 0 then
955	+	Result := ValidUTF8String(TextToSingleLine(Result))
956	+	else
957	+	if UTF8Length(Result) > DisplayWidth then {Show truncation with elipses}
958	+	Result := ValidUTF8String(TextToSingleLine(UTF8Copy(Result,1,DisplayWidth-3))) + '...';
959	+	end;
960	+	end
961	+	end;
962	+
963	+	function TIBMemoField.GetAsString: string;
964	+	var s: RawByteString;
965	+	begin
966	+	s := inherited GetAsString;
967	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
968	+	SetCodePage(s,CodePage,false);
969	+	{$ENDIF}
970	+	Result := s;
971	+	end;
972	+
973	+	function TIBMemoField.GetDefaultWidth: Longint;
974	+	begin
975	+	if DisplayTextAsClassName then
976	+	Result := inherited
977	+	else
978	+	Result := 128;
979	+	end;
980	+
981	+	procedure TIBMemoField.GetText(var AText: string; ADisplayText: Boolean);
982	+	begin
983	+	if ADisplayText then
984	+	begin
985	+	if not DisplayTextAsClassName and (CharacterSetName <> '') then
986	+	AText := GetTruncatedText
987	+	else
988	+	inherited GetText(AText, ADisplayText);
989	+	end
990	+	else
991	+	AText := GetAsString;
992	+	end;
993	+
994	+	procedure TIBMemoField.SetAsString(const AValue: string);
995	+	var s: RawByteString;
996	+	begin
997	+	s := AValue;
998	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
999	+	if StringCodePage(Value) <> CodePage then
1000	+	SetCodePage(s,CodePage,true);
1001	+	{$ENDIF}
1002	+	inherited SetAsString(s);
1003	+	end;
1004	+
1005	+	constructor TIBMemoField.Create(AOwner: TComponent);
1006	+	begin
1007	+	inherited Create(AOwner);
1008	+	BlobType := ftMemo;
1009	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1010	+	FCodePage := CP_NONE;
1011	+	{$ENDIF}
1012	+	end;
1013	+
1014	+	{ TIBControlLink }
1015	+
1016	+	destructor TIBControlLink.Destroy;
1017	+	begin
1018	+	IBDataSet := nil;
1019	+	inherited Destroy;
1020	+	end;
1021	+
1022	+	procedure TIBControlLink.UpdateParams(Sender: TObject);
1023	+	begin
1024	+
1025	+	end;
1026	+
1027	+	procedure TIBControlLink.UpdateSQL(Sender: TObject);
1028	+	begin
1029	+
1030	+	end;
1031	+
1032	+	procedure TIBControlLink.SetIBDataSet(AValue: TIBCustomDataSet);
1033	+	begin
1034	+	if FTIBDataSet = AValue then Exit;
1035	+	if IBDataSet <> nil then
1036	+	IBDataSet.UnRegisterIBLink(self);
1037	+	FTIBDataSet := AValue;
1038	+	if IBDataSet <> nil then
1039	+	IBDataSet.RegisterIBLink(self);
1040	+	end;
1041	+
1042
1043		{ TIBStringField}
1044
1045	<	constructor TIBStringField.Create(AOwner: TComponent);
1045	>	function TIBStringField.GetDefaultWidth: Longint;
1046	>	begin
1047	>	Result := Size div CharacterSetSize;
1048	>	end;
1049	>
1050	>	constructor TIBStringField.Create(aOwner: TComponent);
1051		begin
1052	<	inherited;
1052	>	inherited Create(aOwner);
1053	>	FCharacterSetSize := 1;
1054	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1055	>	FCodePage := CP_NONE;
1056	>	{$ENDIF}
1057		end;
1058
1059		class procedure TIBStringField.CheckTypeSize(Value: Integer);
#	Line 640 | Line 1076 | end;
1076		function TIBStringField.GetValue(var Value: string): Boolean;
1077		var
1078		Buffer: PChar;
1079	+	s: RawByteString;
1080		begin
1081		Buffer := nil;
1082		IBAlloc(Buffer, 0, Size + 1);
#	Line 647 | Line 1084 | begin
1084		Result := GetData(Buffer);
1085		if Result then
1086		begin
1087	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1088	+	s := string(Buffer);
1089	+	SetCodePage(s,CodePage,false);
1090	+	Value := s;
1091	+	//      writeln(FieldName,': ', StringCodePage(Value),', ',Value);
1092	+	{$ELSE}
1093		Value := string(Buffer);
1094	+	{$ENDIF}
1095		if Transliterate and (Value <> '') then
1096		DataSet.Translate(PChar(Value), PChar(Value), False);
1097		end
#	Line 659 | Line 1103 | end;
1103		procedure TIBStringField.SetAsString(const Value: string);
1104		var
1105		Buffer: PChar;
1106	+	s: RawByteString;
1107		begin
1108		Buffer := nil;
1109		IBAlloc(Buffer, 0, Size + 1);
1110		try
1111	<	StrLCopy(Buffer, PChar(Value), Size);
1111	>	s := Value;
1112	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1113	>	if StringCodePage(s) <> CodePage then
1114	>	SetCodePage(s,CodePage,true);
1115	>	{$ENDIF}
1116	>	StrLCopy(Buffer, PChar(s), Size);
1117		if Transliterate then
1118		DataSet.Translate(Buffer, Buffer, True);
1119		SetData(Buffer);
#	Line 672 | Line 1122 | begin
1122		end;
1123		end;
1124
1125	+
1126		{ TIBBCDField }
1127
1128		constructor TIBBCDField.Create(AOwner: TComponent);
#	Line 714 | Line 1165 | end;
1165
1166		function TIBBCDField.GetDataSize: Integer;
1167		begin
1168	+	{$IFDEF TBCDFIELD_IS_BCD}
1169		Result := 8;
1170	+	{$ELSE}
1171	+	Result := inherited GetDataSize
1172	+	{$ENDIF}
1173		end;
1174
1175		{ TIBDataLink }
#	Line 728 | Line 1183 | end;
1183		destructor TIBDataLink.Destroy;
1184		begin
1185		FDataSet.FDataLink := nil;
1186	<	inherited;
1186	>	inherited Destroy;
1187		end;
1188
1189
#	Line 760 | Line 1215 | end;
1215
1216		constructor TIBCustomDataSet.Create(AOwner: TComponent);
1217		begin
1218	<	inherited;
1218	>	inherited Create(AOwner);
1219		FIBLoaded := False;
1220		CheckIBLoaded;
1221		FIBLoaded := True;
1222		FBase := TIBBase.Create(Self);
1223	+	FIBLinks := TList.Create;
1224		FCurrentRecord := -1;
1225		FDeletedRecords := 0;
1226		FUniDirectional := False;
1227		FBufferChunks := BufferCacheSize;
1228		FBlobStreamList := TList.Create;
1229	+	FGeneratorField := TIBGenerator.Create(self);
1230		FDataLink := TIBDataLink.Create(Self);
1231		FQDelete := TIBSQL.Create(Self);
1232		FQDelete.OnSQLChanging := SQLChanging;
#	Line 782 | Line 1239 | begin
1239		FQRefresh.GoToFirstRecordOnExecute := False;
1240		FQSelect := TIBSQL.Create(Self);
1241		FQSelect.OnSQLChanging := SQLChanging;
1242	+	FQSelect.OnSQLChanged := SQLChanged;
1243		FQSelect.GoToFirstRecordOnExecute := False;
1244		FQModify := TIBSQL.Create(Self);
1245		FQModify.OnSQLChanging := SQLChanging;
1246		FQModify.GoToFirstRecordOnExecute := False;
1247		FUpdateRecordTypes := [cusUnmodified, cusModified, cusInserted];
1248		FParamCheck := True;
1249	+	FGenerateParamNames := False;
1250		FForcedRefresh := False;
1251	+	FAutoCommit:= acDisabled;
1252	+	FDataSetCloseAction := dcDiscardChanges;
1253		{Bookmark Size is Integer for IBX}
1254		BookmarkSize := SizeOf(Integer);
1255		FBase.BeforeDatabaseDisconnect := DoBeforeDatabaseDisconnect;
#	Line 802 | Line 1263 | begin
1263		else
1264		if AOwner is TIBTransaction then
1265		Transaction := TIBTransaction(AOwner);
1266	+	FBaseSQLSelect := TStringList.Create;
1267		end;
1268
1269		destructor TIBCustomDataSet.Destroy;
1270		begin
1271	<	inherited;
1271	>	if Active then Active := false;
1272		if FIBLoaded then
1273		begin
1274	+	if assigned(FGeneratorField) then FGeneratorField.Free;
1275		FDataLink.Free;
1276		FBase.Free;
1277		ClearBlobCache;
1278	+	ClearIBLinks;
1279	+	FIBLinks.Free;
1280		FBlobStreamList.Free;
1281		FreeMem(FBufferCache);
1282		FBufferCache := nil;
#	Line 821 | Line 1286 | begin
1286		FOldCacheSize := 0;
1287		FMappedFieldPosition := nil;
1288		end;
1289	+	if assigned(FBaseSQLSelect) then FBaseSQLSelect.Free;
1290	+	if assigned(FParser) then FParser.Free;
1291	+	inherited Destroy;
1292		end;
1293
1294		function TIBCustomDataSet.AdjustCurrentRecord(Buffer: Pointer; GetMode: TGetMode):
#	Line 861 | Line 1329 | end;
1329
1330		procedure TIBCustomDataSet.ApplyUpdates;
1331		var
1332	+	{$IFDEF NEW_TBOOKMARK }
1333	+	CurBookmark: TBookmark;
1334	+	{$ELSE}
1335		CurBookmark: string;
1336	+	{$ENDIF}
1337		Buffer: PRecordData;
1338		CurUpdateTypes: TIBUpdateRecordTypes;
1339		UpdateAction: TIBUpdateAction;
#	Line 921 | Line 1393 | var
1393		procedure UpdateUsingUpdateObject;
1394		begin
1395		try
1396	<	FUpdateObject.Apply(UpdateKind);
1396	>	FUpdateObject.Apply(UpdateKind,PChar(Buffer));
1397		ResetBufferUpdateStatus;
1398		except
1399		on E: Exception do
#	Line 1059 | Line 1531 | begin
1531		end;
1532		end;
1533
1534	+	function TIBCustomDataSet.GetFieldPosition(AliasName: string): integer;
1535	+	var i: integer;
1536	+	Prepared: boolean;
1537	+	begin
1538	+	Result := 0;
1539	+	Prepared := FInternalPrepared;
1540	+	if not Prepared then
1541	+	InternalPrepare;
1542	+	try
1543	+	for i := 0 to Length(FAliasNameList) - 1 do
1544	+	if FAliasNameList[i] = AliasName then
1545	+	begin
1546	+	Result := i + 1;
1547	+	Exit
1548	+	end;
1549	+	finally
1550	+	if not Prepared then
1551	+	InternalUnPrepare;
1552	+	end;
1553	+	end;
1554	+
1555		procedure TIBCustomDataSet.ActivateConnection;
1556		begin
1557		if not Assigned(Database) then
#	Line 1119 | Line 1612 | begin
1612		IBError(ibxeDatasetClosed, [nil]);
1613		end;
1614
1615	+	function TIBCustomDataSet.CreateParser: TSelectSQLParser;
1616	+	begin
1617	+	Result := TSelectSQLParser.Create(self,FBaseSQLSelect);
1618	+	Result.OnSQLChanging := SQLChanging
1619	+	end;
1620	+
1621		procedure TIBCustomDataSet.CheckNotUniDirectional;
1622		begin
1623		if UniDirectional then
#	Line 1222 | Line 1721 | begin
1721		FDatabaseFree(Sender);
1722		end;
1723
1724	<	procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject);
1724	>	procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject;
1725	>	Action: TTransactionAction);
1726		begin
1727	<	if Active then
1728	<	Active := False;
1727	>	FCloseAction := Action;
1728	>	FInTransactionEnd := true;
1729	>	try
1730	>	if Active then
1731	>	Active := False;
1732	>	finally
1733	>	FInTransactionEnd := false;
1734	>	end;
1735		if FQSelect <> nil then
1736		FQSelect.FreeHandle;
1737		if FQDelete <> nil then
#	Line 1263 | Line 1769 | var
1769		LocalData: Pointer;
1770		LocalDate, LocalDouble: Double;
1771		LocalInt: Integer;
1772	+	LocalBool: wordBool;
1773		LocalInt64: Int64;
1774		LocalCurrency: Currency;
1775		FieldsLoaded: Integer;
1776	+	temp: TIBXSQLVAR;
1777		begin
1778		p := PRecordData(Buffer);
1779		{ Make sure blob cache is empty }
#	Line 1399 | Line 1907 | begin
1907		if (rdFields[j].fdDataLength = 0) then
1908		LocalData := nil
1909		else
1910	<	LocalData := @Qry.Current[i].Data^.sqldata[2];
1910	>	begin
1911	>	temp :=  Qry.Current[i];
1912	>	LocalData := @temp.Data^.sqldata[2];
1913	>	(*              LocalData := @Qry.Current[i].Data^.sqldata[2];*)
1914	>	end;
1915		end;
1916		end;
1917	+	SQL_BOOLEAN:
1918	+	begin
1919	+	LocalBool:= false;
1920	+	rdFields[j].fdDataSize := SizeOf(wordBool);
1921	+	if RecordNumber >= 0 then
1922	+	LocalBool := Qry.Current[i].AsBoolean;
1923	+	LocalData := PChar(@LocalBool);
1924	+	end;
1925		else { SQL_TEXT, SQL_BLOB, SQL_ARRAY, SQL_QUAD }
1926		begin
1927		rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
#	Line 1526 | Line 2046 | end;
2046		procedure TIBCustomDataSet.InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer);
2047		begin
2048		if (Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukDelete).Text <> '')) then
2049	<	FUpdateObject.Apply(ukDelete)
2049	>	FUpdateObject.Apply(ukDelete,Buff)
2050		else
2051		begin
2052		SetInternalSQLParams(FQDelete, Buff);
#	Line 1543 | Line 2063 | end;
2063		function TIBCustomDataSet.InternalLocate(const KeyFields: string;
2064		const KeyValues: Variant; Options: TLocateOptions): Boolean;
2065		var
2066	<	fl: TList;
2066	>	keyFieldList: TList;
2067	>	{$IFDEF NEW_TBOOKMARK }
2068	>	CurBookmark: TBookmark;
2069	>	{$ELSE}
2070		CurBookmark: string;
2071	<	fld, val: Variant;
2072	<	i, fld_cnt: Integer;
2071	>	{$ENDIF}
2072	>	fieldValue: Variant;
2073	>	lookupValues: array of variant;
2074	>	i, fieldCount: Integer;
2075	>	fieldValueAsString: string;
2076	>	lookupValueAsString: string;
2077		begin
2078	<	fl := TList.Create;
2078	>	keyFieldList := TList.Create;
2079		try
2080	<	GetFieldList(fl, KeyFields);
2081	<	fld_cnt := fl.Count;
2080	>	GetFieldList(keyFieldList, KeyFields);
2081	>	fieldCount := keyFieldList.Count;
2082		CurBookmark := Bookmark;
2083	<	result := False;
2084	<	while ((not result) and (not EOF)) do
2083	>	result := false;
2084	>	SetLength(lookupValues, fieldCount);
2085	>	if not EOF then
2086		begin
2087	<	i := 0;
1560	<	result := True;
1561	<	while (result and (i < fld_cnt)) do
2087	>	for i := 0 to fieldCount - 1 do  {expand key values into lookupValues array}
2088		begin
2089	<	if fld_cnt > 1 then
2090	<	val := KeyValues[i]
2089	>	if VarIsArray(KeyValues) then
2090	>	lookupValues[i] := KeyValues[i]
2091	>	else
2092	>	if i > 0 then
2093	>	lookupValues[i] := NULL
2094		else
2095	<	val := KeyValues;
2096	<	fld := TField(fl[i]).Value;
2097	<	result := not (VarIsNull(val) xor VarIsNull(fld));
2098	<	if result and not VarIsNull(val) then
2095	>	lookupValues[0] := KeyValues;
2096	>
2097	>	{convert to upper case is case insensitive search}
2098	>	if (TField(keyFieldList[i]).DataType = ftString) and
2099	>	not VarIsNull(lookupValues[i]) and (loCaseInsensitive in Options) then
2100	>	lookupValues[i] := UpperCase(lookupValues[i]);
2101	>	end;
2102	>	end;
2103	>	while not result and not EOF do   {search for a matching record}
2104	>	begin
2105	>	i := 0;
2106	>	result := true;
2107	>	while result and (i < fieldCount) do
2108	>	{see if all of the key fields matches}
2109	>	begin
2110	>	fieldValue := TField(keyFieldList[i]).Value;
2111	>	result := not (VarIsNull(fieldValue) xor VarIsNull(lookupValues[i]));
2112	>	if result and not VarIsNull(fieldValue) then
2113		begin
2114		try
2115	<	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
2115	>	if TField(keyFieldList[i]).DataType = ftString then
2116		begin
2117	+	{strings need special handling because of the locate options that
2118	+	apply to them}
2119	+	fieldValueAsString := TField(keyFieldList[i]).AsString;
2120	+	lookupValueAsString := lookupValues[i];
2121		if (loCaseInsensitive in Options) then
2122	<	begin
2123	<	fld := AnsiUpperCase(fld);
1582	<	val := AnsiUpperCase(val);
1583	<	end;
1584	<	fld := TrimRight(fld);
1585	<	val := TrimRight(val);
2122	>	fieldValueAsString := UpperCase(fieldValueAsString);
2123	>
2124		if (loPartialKey in Options) then
2125	<	result := result and (AnsiPos(val, fld) = 1)
2125	>	result := result and (Pos(lookupValueAsString, fieldValueAsString) = 1)
2126		else
2127	<	result := result and (val = fld);
2128	<	end else
2129	<	result := result and (val = fld);
2127	>	result := result and (fieldValueAsString = lookupValueAsString);
2128	>	end
2129	>	else
2130	>	result := result and (lookupValues[i] =
2131	>	VarAsType(fieldValue, VarType(lookupValues[i])));
2132	>	except on EVariantError do
2133	>	result := False;
2134	>	end;
2135		end;
2136		Inc(i);
2137		end;
2138		if not result then
2139	<	Next;
2139	>	Next;
2140		end;
2141		if not result then
2142		Bookmark := CurBookmark
2143		else
2144		CursorPosChanged;
2145		finally
2146	<	fl.Free;
2146	>	keyFieldList.Free;
2147	>	SetLength(lookupValues,0)
2148		end;
2149		end;
2150
#	Line 1628 | Line 2172 | begin
2172		if Assigned(FUpdateObject) then
2173		begin
2174		if (Qry = FQDelete) then
2175	<	FUpdateObject.Apply(ukDelete)
2175	>	FUpdateObject.Apply(ukDelete,Buff)
2176		else if (Qry = FQInsert) then
2177	<	FUpdateObject.Apply(ukInsert)
2177	>	FUpdateObject.Apply(ukInsert,Buff)
2178		else
2179	<	FUpdateObject.Apply(ukModify);
2179	>	FUpdateObject.Apply(ukModify,Buff);
2180		end
2181		else begin
2182		SetInternalSQLParams(Qry, Buff);
#	Line 1649 | Line 2193 | end;
2193		procedure TIBCustomDataSet.InternalRefreshRow;
2194		var
2195		Buff: PChar;
1652	–	SetCursor: Boolean;
2196		ofs: DWORD;
2197		Qry: TIBSQL;
2198		begin
2199	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1657	<	if SetCursor then
1658	<	Screen.Cursor := crHourGlass;
2199	>	FBase.SetCursor;
2200		try
2201		Buff := GetActiveBuf;
2202		if CanRefresh then
#	Line 1699 | Line 2240 | begin
2240		else
2241		IBError(ibxeCannotRefresh, [nil]);
2242		finally
2243	<	if SetCursor and (Screen.Cursor = crHourGlass) then
1703	<	Screen.Cursor := crDefault;
2243	>	FBase.RestoreCursor;
2244		end;
2245		end;
2246
#	Line 1771 | Line 2311 | end;
2311
2312		procedure TIBCustomDataSet.InternalPrepare;
2313		var
1774	–	SetCursor: Boolean;
2314		DidActivate: Boolean;
2315		begin
2316		if FInternalPrepared then
2317		Exit;
2318		DidActivate := False;
2319	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1781	<	if SetCursor then
1782	<	Screen.Cursor := crHourGlass;
2319	>	FBase.SetCursor;
2320		try
2321		ActivateConnection;
2322		DidActivate := ActivateTransaction;
2323		FBase.CheckDatabase;
2324		FBase.CheckTransaction;
2325	+	if HasParser and (FParser.SQLText <> FQSelect.SQL.Text) then
2326	+	begin
2327	+	FQSelect.OnSQLChanged := nil; {Do not react to change}
2328	+	try
2329	+	FQSelect.SQL.Text := FParser.SQLText;
2330	+	finally
2331	+	FQSelect.OnSQLChanged := SQLChanged;
2332	+	end;
2333	+	end;
2334	+	//   writeln( FQSelect.SQL.Text);
2335		if FQSelect.SQL.Text <> '' then
2336		begin
2337		if not FQSelect.Prepared then
2338		begin
2339	+	FQSelect.GenerateParamNames := FGenerateParamNames;
2340		FQSelect.ParamCheck := ParamCheck;
2341		FQSelect.Prepare;
2342		end;
2343	<	if (FQDelete.SQL.Text <> '') and (not FQDelete.Prepared) then
2343	>	FQDelete.GenerateParamNames := FGenerateParamNames;
2344	>	if (Trim(FQDelete.SQL.Text) <> '') and (not FQDelete.Prepared) then
2345		FQDelete.Prepare;
2346	<	if (FQInsert.SQL.Text <> '') and (not FQInsert.Prepared) then
2346	>	FQInsert.GenerateParamNames := FGenerateParamNames;
2347	>	if (Trim(FQInsert.SQL.Text) <> '') and (not FQInsert.Prepared) then
2348		FQInsert.Prepare;
2349	<	if (FQRefresh.SQL.Text <> '') and (not FQRefresh.Prepared) then
2349	>	FQRefresh.GenerateParamNames := FGenerateParamNames;
2350	>	if (Trim(FQRefresh.SQL.Text) <> '') and (not FQRefresh.Prepared) then
2351		FQRefresh.Prepare;
2352	<	if (FQModify.SQL.Text <> '') and (not FQModify.Prepared) then
2352	>	FQModify.GenerateParamNames := FGenerateParamNames;
2353	>	if (Trim(FQModify.SQL.Text) <> '') and (not FQModify.Prepared) then
2354		FQModify.Prepare;
2355		FInternalPrepared := True;
2356		InternalInitFieldDefs;
#	Line 1807 | Line 2359 | begin
2359		finally
2360		if DidActivate then
2361		DeactivateTransaction;
2362	<	if SetCursor and (Screen.Cursor = crHourGlass) then
1811	<	Screen.Cursor := crDefault;
2362	>	FBase.RestoreCursor;
2363		end;
2364		end;
2365
#	Line 1998 | Line 2549 | begin
2549		end;
2550		SQL_TIMESTAMP:
2551		Qry.Params[i].AsDateTime :=
2552	<	TimeStampToDateTime(
2553	<	MSecsToTimeStamp(PDouble(data)^));
2552	>	TimeStampToDateTime(MSecsToTimeStamp(trunc(PDouble(data)^)));
2553	>	SQL_BOOLEAN:
2554	>	Qry.Params[i].AsBoolean := PWordBool(data)^;
2555		end;
2556		end;
2557		end;
#	Line 2085 | Line 2637 | begin
2637		end;
2638		end;
2639
2640	+	procedure TIBCustomDataSet.RegisterIBLink(Sender: TIBControlLink);
2641	+	begin
2642	+	if FIBLinks.IndexOf(Sender) = -1 then
2643	+	FIBLinks.Add(Sender);
2644	+	end;
2645	+
2646
2647		procedure TIBCustomDataSet.SQLChanging(Sender: TObject);
2648		begin
2649	<	if FOpen then
2650	<	InternalClose;
2649	>	Active := false;
2650	>	{  if FOpen then
2651	>	InternalClose;}
2652		if FInternalPrepared then
2653		InternalUnPrepare;
2654	+	FieldDefs.Clear;
2655	+	FieldDefs.Updated := false;
2656	+	end;
2657	+
2658	+	procedure TIBCustomDataSet.SQLChanged(Sender: TObject);
2659	+	begin
2660	+	FBaseSQLSelect.assign(FQSelect.SQL);
2661		end;
2662
2663		{ I can "undelete" uninserted records (make them "inserted" again).
#	Line 2120 | Line 2686 | begin
2686		end;
2687		end;
2688
2689	+	procedure TIBCustomDataSet.UnRegisterIBLink(Sender: TIBControlLink);
2690	+	begin
2691	+	FIBLinks.Remove(Sender);
2692	+	end;
2693	+
2694		function TIBCustomDataSet.UpdateStatus: TUpdateStatus;
2695		begin
2696		if Active then
#	Line 2136 | Line 2707 | begin
2707		Result := Assigned( FQSelect ) and FQSelect.EOF;
2708		end;
2709
2710	+	function TIBCustomDataSet.ParamByName(ParamName: String): TIBXSQLVAR;
2711	+	begin
2712	+	ActivateConnection;
2713	+	ActivateTransaction;
2714	+	if not FInternalPrepared then
2715	+	InternalPrepare;
2716	+	Result := Params.ByName(ParamName);
2717	+	end;
2718	+
2719	+	{Beware: the parameter FCache is used as an identifier to determine which
2720	+	cache is being operated on and is not referenced in the computation.
2721	+	The result is an adjusted offset into the identified cache, either the
2722	+	Buffer Cache or the old Buffer Cache.}
2723	+
2724		function TIBCustomDataSet.AdjustPosition(FCache: PChar; Offset: DWORD;
2725	<	Origin: Integer): Integer;
2725	>	Origin: Integer): DWORD;
2726		var
2727		OldCacheSize: Integer;
2728		begin
#	Line 2174 | Line 2759 | procedure TIBCustomDataSet.ReadCache(FCa
2759		Buffer: PChar);
2760		var
2761		pCache: PChar;
2762	+	AdjustedOffset: DWORD;
2763		bOld: Boolean;
2764		begin
2765		bOld := (FCache = FOldBufferCache);
2766	<	pCache := PChar(AdjustPosition(FCache, Offset, Origin));
2766	>	AdjustedOffset := AdjustPosition(FCache, Offset, Origin);
2767		if not bOld then
2768	<	pCache := FBufferCache + Integer(pCache)
2768	>	pCache := FBufferCache + AdjustedOffset
2769		else
2770	<	pCache := FOldBufferCache + Integer(pCache);
2770	>	pCache := FOldBufferCache + AdjustedOffset;
2771		Move(pCache^, Buffer^, DWORD(FRecordBufferSize));
2772		AdjustPosition(FCache, FRecordBufferSize, FILE_CURRENT);
2773		end;
#	Line 2211 | Line 2797 | procedure TIBCustomDataSet.WriteCache(FC
2797		Buffer: PChar);
2798		var
2799		pCache: PChar;
2800	+	AdjustedOffset: DWORD;
2801		bOld: Boolean;
2802		dwEnd: DWORD;
2803		begin
2804		bOld := (FCache = FOldBufferCache);
2805	<	pCache := PChar(AdjustPosition(FCache, Offset, Origin));
2805	>	AdjustedOffset := AdjustPosition(FCache, Offset, Origin);
2806		if not bOld then
2807	<	pCache := FBufferCache + Integer(pCache)
2807	>	pCache := FBufferCache + AdjustedOffset
2808		else
2809	<	pCache := FOldBufferCache + Integer(pCache);
2809	>	pCache := FOldBufferCache + AdjustedOffset;
2810		Move(Buffer^, pCache^, FRecordBufferSize);
2811		dwEnd := AdjustPosition(FCache, FRecordBufferSize, FILE_CURRENT);
2812		if not bOld then
#	Line 2330 | Line 2917 | begin
2917		if FCachedUpdates and
2918		(Buff^.rdCachedUpdateStatus in [cusUnmodified]) then
2919		SaveOldBuffer(PChar(Buff));
2920	<	inherited;
2920	>	inherited DoBeforeDelete;
2921	>	end;
2922	>
2923	>	procedure TIBCustomDataSet.DoAfterDelete;
2924	>	begin
2925	>	inherited DoAfterDelete;
2926	>	FBase.DoAfterDelete(self);
2927	>	InternalAutoCommit;
2928		end;
2929
2930		procedure TIBCustomDataSet.DoBeforeEdit;
#	Line 2344 | Line 2938 | begin
2938		if FCachedUpdates and (Buff^.rdCachedUpdateStatus in [cusUnmodified, cusInserted]) then
2939		SaveOldBuffer(PChar(Buff));
2940		CopyRecordBuffer(GetActiveBuf, FOldBuffer);
2941	<	inherited;
2941	>	inherited DoBeforeEdit;
2942	>	end;
2943	>
2944	>	procedure TIBCustomDataSet.DoAfterEdit;
2945	>	begin
2946	>	inherited DoAfterEdit;
2947	>	FBase.DoAfterEdit(self);
2948		end;
2949
2950		procedure TIBCustomDataSet.DoBeforeInsert;
2951		begin
2952		if not CanInsert then
2953		IBError(ibxeCannotInsert, [nil]);
2954	<	inherited;
2954	>	inherited DoBeforeInsert;
2955	>	end;
2956	>
2957	>	procedure TIBCustomDataSet.DoAfterInsert;
2958	>	begin
2959	>	if GeneratorField.ApplyOnEvent = gaeOnNewRecord then
2960	>	GeneratorField.Apply;
2961	>	inherited DoAfterInsert;
2962	>	FBase.DoAfterInsert(self);
2963	>	end;
2964	>
2965	>	procedure TIBCustomDataSet.DoBeforeClose;
2966	>	begin
2967	>	inherited DoBeforeClose;
2968	>	if State in [dsInsert,dsEdit] then
2969	>	begin
2970	>	if FInTransactionEnd and (FCloseAction = TARollback) then
2971	>	Exit;
2972	>
2973	>	if DataSetCloseAction = dcSaveChanges then
2974	>	Post;
2975	>	{Note this can fail with an exception e.g. due to
2976	>	database validation error. In which case the dataset remains open }
2977	>	end;
2978	>	end;
2979	>
2980	>	procedure TIBCustomDataSet.DoBeforeOpen;
2981	>	var i: integer;
2982	>	begin
2983	>	if assigned(FParser) then
2984	>	FParser.Reset;
2985	>	for i := 0 to FIBLinks.Count - 1 do
2986	>	TIBControlLink(FIBLinks[i]).UpdateSQL(self);
2987	>	inherited DoBeforeOpen;
2988	>	for i := 0 to FIBLinks.Count - 1 do
2989	>	TIBControlLink(FIBLinks[i]).UpdateParams(self);
2990	>	end;
2991	>
2992	>	procedure TIBCustomDataSet.DoBeforePost;
2993	>	begin
2994	>	inherited DoBeforePost;
2995	>	if (State = dsInsert) and
2996	>	(GeneratorField.ApplyOnEvent = gaeOnPostRecord) then
2997	>	GeneratorField.Apply
2998	>	end;
2999	>
3000	>	procedure TIBCustomDataSet.DoAfterPost;
3001	>	begin
3002	>	inherited DoAfterPost;
3003	>	FBase.DoAfterPost(self);
3004	>	InternalAutoCommit;
3005		end;
3006
3007		procedure TIBCustomDataSet.FetchAll;
3008		var
3009	<	SetCursor: Boolean;
3009	>	{$IFDEF NEW_TBOOKMARK }
3010	>	CurBookmark: TBookmark;
3011	>	{$ELSE}
3012		CurBookmark: string;
3013	+	{$ENDIF}
3014		begin
3015	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3016	<	if SetCursor then
2364	<	Screen.Cursor := crHourGlass;
2365	<	try
3015	>	FBase.SetCursor;
3016	>	try
3017		if FQSelect.EOF or not FQSelect.Open then
3018		exit;
3019		DisableControls;
#	Line 2374 | Line 3025 | begin
3025		EnableControls;
3026		end;
3027		finally
3028	<	if SetCursor and (Screen.Cursor = crHourGlass) then
2378	<	Screen.Cursor := crDefault;
3028	>	FBase.RestoreCursor;
3029		end;
3030		end;
3031
#	Line 2423 | Line 3073 | begin
3073		result := FDataLink.DataSource;
3074		end;
3075
3076	+	function TIBCustomDataSet.GetDBAliasName(FieldNo: integer): string;
3077	+	begin
3078	+	Result := FAliasNameMap[FieldNo-1]
3079	+	end;
3080	+
3081	+	function TIBCustomDataSet.GetFieldDefFromAlias(aliasName: string): TFieldDef;
3082	+	var
3083	+	i: integer;
3084	+	begin
3085	+	Result := nil;
3086	+	for i := 0 to Length(FAliasNameMap) - 1 do
3087	+	if FAliasNameMap[i] = aliasName then
3088	+	begin
3089	+	Result := FieldDefs[i];
3090	+	Exit
3091	+	end;
3092	+	end;
3093	+
3094		function TIBCustomDataSet.GetFieldClass(FieldType: TFieldType): TFieldClass;
3095		begin
3096		Result := DefaultFieldClasses[FieldType];
#	Line 2441 | Line 3109 | begin
3109		result := False;
3110		Buff := GetActiveBuf;
3111		if (Buff = nil) or
3112	<	(not IsVisible(Buff)) then
3112	>	(not IsVisible(Buff)) or not assigned(Field.DataSet) then
3113		exit;
3114		{ The intention here is to stuff the buffer with the data for the
3115		referenced field for the current record }
#	Line 2463 | Line 3131 | begin
3131		Data := Buff + CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs;
3132		if (fdDataType = SQL_VARYING) or (fdDataType = SQL_TEXT) then
3133		begin
3134	<	Move(Data^, Buffer^, fdDataLength);
3135	<	PChar(Buffer)[fdDataLength] := #0;
3134	>	if fdDataLength < Field.DataSize then
3135	>	begin
3136	>	Move(Data^, Buffer^, fdDataLength);
3137	>	PChar(Buffer)[fdDataLength] := #0;
3138	>	end
3139	>	else
3140	>	IBError(ibxeFieldSizeError,[Field.FieldName])
3141		end
3142		else
3143		Move(Data^, Buffer^, Field.DataSize);
#	Line 2507 | Line 3180 | begin
3180		if not Accept and (GetMode = gmCurrent) then
3181		GetMode := gmPrior;
3182		except
3183	<	//        Application.HandleException(Self);
3183	>	//        FBase.HandleException(Self);
3184		end;
3185		end;
3186		RestoreState(SaveState);
#	Line 2601 | Line 3274 | begin
3274		result := FRecordBufferSize;
3275		end;
3276
3277	+	procedure TIBCustomDataSet.InternalAutoCommit;
3278	+	begin
3279	+	with Transaction do
3280	+	if InTransaction and (FAutoCommit = acCommitRetaining) then
3281	+	begin
3282	+	if CachedUpdates then ApplyUpdates;
3283	+	CommitRetaining;
3284	+	end;
3285	+	end;
3286	+
3287		procedure TIBCustomDataSet.InternalAddRecord(Buffer: Pointer; Append: Boolean);
3288		begin
3289		CheckEditState;
#	Line 2629 | Line 3312 | var
3312		Buff: PChar;
3313		CurRec: Integer;
3314		begin
3315	<	inherited;
3315	>	inherited InternalCancel;
3316		Buff := GetActiveBuf;
3317		if Buff <> nil then begin
3318		CurRec := FCurrentRecord;
#	Line 2672 | Line 3355 | begin
3355		FreeMem(FOldBufferCache);
3356		FOldBufferCache := nil;
3357		BindFields(False);
3358	+	ResetParser;
3359		if DefaultFields then DestroyFields;
3360		end;
3361
3362		procedure TIBCustomDataSet.InternalDelete;
3363		var
3364		Buff: PChar;
2681	–	SetCursor: Boolean;
3365		begin
3366	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
2684	<	if SetCursor then
2685	<	Screen.Cursor := crHourGlass;
3366	>	FBase.SetCursor;
3367		try
3368		Buff := GetActiveBuf;
3369		if CanDelete then
#	Line 2707 | Line 3388 | begin
3388		end else
3389		IBError(ibxeCannotDelete, [nil]);
3390		finally
3391	<	if SetCursor and (Screen.Cursor = crHourGlass) then
2711	<	Screen.Cursor := crDefault;
3391	>	FBase.RestoreCursor;
3392		end;
3393		end;
3394
#	Line 2724 | Line 3404 | end;
3404
3405		procedure TIBCustomDataSet.InternalHandleException;
3406		begin
3407	<	Application.HandleException(Self)
3407	>	FBase.HandleException(Self)
3408		end;
3409
3410		procedure TIBCustomDataSet.InternalInitFieldDefs;
3411	+	begin
3412	+	if not InternalPrepared then
3413	+	begin
3414	+	InternalPrepare;
3415	+	exit;
3416	+	end;
3417	+	FieldDefsFromQuery(FQSelect);
3418	+	end;
3419	+
3420	+	procedure TIBCustomDataSet.FieldDefsFromQuery(SourceQuery: TIBSQL);
3421		const
3422		DefaultSQL = 'Select F.RDB$COMPUTED_BLR, ' + {do not localize}
3423		'F.RDB$DEFAULT_VALUE, R.RDB$FIELD_NAME ' + {do not localize}
#	Line 2739 | Line 3429 | const
3429		var
3430		FieldType: TFieldType;
3431		FieldSize: Word;
3432	+	charSetID: short;
3433	+	CharSetSize: integer;
3434	+	CharSetName: RawByteString;
3435	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3436	+	FieldCodePage: TSystemCodePage;
3437	+	{$ENDIF}
3438		FieldNullable : Boolean;
3439		i, FieldPosition, FieldPrecision: Integer;
3440	<	FieldAliasName: string;
3440	>	FieldAliasName, DBAliasName: string;
3441		RelationName, FieldName: string;
3442		Query : TIBSQL;
3443		FieldIndex: Integer;
#	Line 2841 | Line 3537 | var
3537		end;
3538
3539		begin
2844	–	if not InternalPrepared then
2845	–	begin
2846	–	InternalPrepare;
2847	–	exit;
2848	–	end;
3540		FRelationNodes := TRelationNode.Create;
3541		FNeedsRefresh := False;
3542		Database.InternalTransaction.StartTransaction;
#	Line 2856 | Line 3547 | begin
3547		FieldDefs.BeginUpdate;
3548		FieldDefs.Clear;
3549		FieldIndex := 0;
3550	<	if (Length(FMappedFieldPosition) < FQSelect.Current.Count) then
3551	<	SetLength(FMappedFieldPosition, FQSelect.Current.Count);
3550	>	if (Length(FMappedFieldPosition) < SourceQuery.Current.Count) then
3551	>	SetLength(FMappedFieldPosition, SourceQuery.Current.Count);
3552		Query.SQL.Text := DefaultSQL;
3553		Query.Prepare;
3554	<	for i := 0 to FQSelect.Current.Count - 1 do
3555	<	with FQSelect.Current[i].Data^ do
3554	>	SetLength(FAliasNameMap, SourceQuery.Current.Count);
3555	>	SetLength(FAliasNameList, SourceQuery.Current.Count);
3556	>	for i := 0 to SourceQuery.Current.Count - 1 do
3557	>	with SourceQuery.Current[i].Data^ do
3558		begin
3559		{ Get the field name }
3560	<	SetString(FieldAliasName, aliasname, aliasname_length);
3560	>	FieldAliasName := SourceQuery.Current[i].Name;
3561	>	SetString(DBAliasName, aliasname, aliasname_length);
3562		SetString(RelationName, relname, relname_length);
3563		SetString(FieldName, sqlname, sqlname_length);
3564	+	FAliasNameList[i] := DBAliasName;
3565		FieldSize := 0;
3566		FieldPrecision := 0;
3567	<	FieldNullable := FQSelect.Current[i].IsNullable;
3567	>	FieldNullable := SourceQuery.Current[i].IsNullable;
3568	>	CharSetSize := 0;
3569	>	CharSetName := '';
3570	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3571	>	FieldCodePage := CP_NONE;
3572	>	{$ENDIF}
3573		case sqltype and not 1 of
3574		{ All VARCHAR's must be converted to strings before recording
3575		their values }
3576		SQL_VARYING, SQL_TEXT:
3577		begin
3578	+	CharSetSize := FBase.GetCharSetSize(sqlsubtype and $FF);
3579	+	CharSetName := FBase.GetCharSetName(sqlsubtype and $FF);
3580	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3581	+	FieldCodePage := FBase.GetCodePage(sqlsubtype and $FF);
3582	+	{$ENDIF}
3583	+	{FieldSize is encoded for strings - see TIBStringField.SetSize for decode}
3584		FieldSize := sqllen;
3585	<	FieldType := ftString;
3585	>	if CharSetSize = 2 then
3586	>	FieldType := ftWideString
3587	>	else
3588	>	FieldType := ftString;
3589		end;
3590		{ All Doubles/Floats should be cast to doubles }
3591		SQL_DOUBLE, SQL_FLOAT:
#	Line 2902 | Line 3611 | begin
3611		FieldSize := -sqlscale;
3612		end
3613		else
3614	<	FieldType := ftFloat;
3614	>	if Database.SQLDialect = 1 then
3615	>	FieldType := ftFloat
3616	>	else
3617	>	if (FieldCount > i) and (Fields[i] is TFloatField) then
3618	>	FieldType := ftFloat
3619	>	else
3620	>	begin
3621	>	FieldType := ftFMTBCD;
3622	>	FieldPrecision := 9;
3623	>	FieldSize := -sqlscale;
3624		end;
3625	+	end;
3626	+
3627		SQL_INT64:
3628		begin
3629		if (sqlscale = 0) then
#	Line 2915 | Line 3635 | begin
3635		FieldSize := -sqlscale;
3636		end
3637		else
3638	<	FieldType := ftFloat;
3639	<	end;
3638	>	FieldType := ftFloat
3639	>	end;
3640		SQL_TIMESTAMP: FieldType := ftDateTime;
3641		SQL_TYPE_TIME: FieldType := ftTime;
3642		SQL_TYPE_DATE: FieldType := ftDate;
#	Line 2924 | Line 3644 | begin
3644		begin
3645		FieldSize := sizeof (TISC_QUAD);
3646		if (sqlsubtype = 1) then
3647	<	FieldType := ftmemo
3647	>	begin
3648	>	if FBase.GetDefaultCharSetName <> '' then
3649	>	begin
3650	>	CharSetSize := FBase.GetDefaultCharSetSize;
3651	>	CharSetName := FBase.GetDefaultCharSetName;
3652	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3653	>	FieldCodePage := FBase.GetDefaultCodePage;
3654	>	{$ENDIF}
3655	>	end
3656	>	else
3657	>	if strpas(sqlname) <> '' then
3658	>	begin
3659	>	charSetID := GetBlobCharSetID(Database.Handle,Database.InternalTransaction.Handle,
3660	>	@relname,@sqlname);
3661	>	CharSetSize := FBase.GetCharSetSize(charSetID);
3662	>	CharSetName := FBase.GetCharSetName(charSetID);
3663	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3664	>	FieldCodePage := FBase.GetCodePage(charSetID);
3665	>	{$ENDIF}
3666	>	end
3667	>	else  {Complex SQL with no identifiable column and no connection default}
3668	>	begin
3669	>	CharSetName := '';
3670	>	CharSetSize := 1;
3671	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3672	>	FieldCodePage := CP_NONE;
3673	>	{$ENDIF}
3674	>	end;
3675	>	if CharSetSize = 2 then
3676	>	FieldType := ftWideMemo
3677	>	else
3678	>	FieldType := ftMemo;
3679	>	end
3680		else
3681		FieldType := ftBlob;
3682		end;
#	Line 2933 | Line 3685 | begin
3685		FieldSize := sizeof (TISC_QUAD);
3686		FieldType := ftUnknown;
3687		end;
3688	+	SQL_BOOLEAN:
3689	+	FieldType:= ftBoolean;
3690		else
3691		FieldType := ftUnknown;
3692		end;
#	Line 2941 | Line 3695 | begin
3695		begin
3696		FMappedFieldPosition[FieldIndex] := FieldPosition;
3697		Inc(FieldIndex);
3698	<	with FieldDefs.AddFieldDef do
3698	>	with TIBFieldDef.Create(FieldDefs,'',FieldType,0,False,FieldDefs.Count+1) do
3699		begin
3700	<	Name := string( FieldAliasName );
3701	<	FieldNo := FieldPosition;
2948	<	DataType := FieldType;
3700	>	Name := FieldAliasName;
3701	>	FAliasNameMap[FieldNo-1] := DBAliasName;
3702		Size := FieldSize;
3703		Precision := FieldPrecision;
3704	<	Required := False;
3704	>	Required := not FieldNullable;
3705		InternalCalcField := False;
3706	+	CharacterSetSize := CharSetSize;
3707	+	CharacterSetName := CharSetName;
3708	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3709	+	CodePage := FieldCodePage;
3710	+	{$ENDIF}
3711		if (FieldName <> '') and (RelationName <> '') then
3712		begin
3713		if Has_COMPUTED_BLR(RelationName, FieldName) then
#	Line 3029 | Line 3787 | begin
3787		else case cur_field.DataType of
3788		ftString:
3789		cur_param.AsString := cur_field.AsString;
3790	<	ftBoolean, ftSmallint, ftWord:
3790	>	ftBoolean:
3791	>	cur_param.AsBoolean := cur_field.AsBoolean;
3792	>	ftSmallint, ftWord:
3793		cur_param.AsShort := cur_field.AsInteger;
3794		ftInteger:
3795		cur_param.AsLong := cur_field.AsInteger;
#	Line 3082 | Line 3842 | begin
3842		end;
3843
3844		procedure TIBCustomDataSet.InternalOpen;
3085	–	var
3086	–	SetCursor: Boolean;
3845
3846		function RecordDataLength(n: Integer): Long;
3847		begin
3848		result := SizeOf(TRecordData) + ((n - 1) * SizeOf(TFieldData));
3849		end;
3850
3851	+	function GetFieldDef(aFieldNo: integer): TIBFieldDef;
3852	+	var i: integer;
3853	+	begin
3854	+	Result := nil;
3855	+	for i := 0 to FieldDefs.Count - 1 do
3856	+	if FieldDefs[i].FieldNo = aFieldNo then
3857	+	begin
3858	+	Result := TIBFieldDef(FieldDefs[i]);
3859	+	break;
3860	+	end;
3861	+	end;
3862	+
3863	+	procedure SetExtendedProperties;
3864	+	var i: integer;
3865	+	IBFieldDef: TIBFieldDef;
3866	+	begin
3867	+	for i := 0 to Fields.Count - 1 do
3868	+	if Fields[i].FieldNo > 0 then
3869	+	begin
3870	+	if(Fields[i] is TIBStringField) then
3871	+	with TIBStringField(Fields[i]) do
3872	+	begin
3873	+	IBFieldDef := GetFieldDef(FieldNo);
3874	+	if IBFieldDef <> nil then
3875	+	begin
3876	+	CharacterSetSize := IBFieldDef.CharacterSetSize;
3877	+	CharacterSetName := IBFieldDef.CharacterSetName;
3878	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3879	+	CodePage := IBFieldDef.CodePage;
3880	+	{$ENDIF}
3881	+	end;
3882	+	end
3883	+	else
3884	+	if(Fields[i] is TIBWideStringField) then
3885	+	with TIBWideStringField(Fields[i]) do
3886	+	begin
3887	+	IBFieldDef := GetFieldDef(FieldNo);
3888	+	if IBFieldDef <> nil then
3889	+	begin
3890	+	CharacterSetSize := IBFieldDef.CharacterSetSize;
3891	+	CharacterSetName := IBFieldDef.CharacterSetName;
3892	+	end;
3893	+	end
3894	+	else
3895	+	if(Fields[i] is TIBMemoField) then
3896	+	with TIBMemoField(Fields[i]) do
3897	+	begin
3898	+	IBFieldDef := GetFieldDef(FieldNo);
3899	+	if IBFieldDef <> nil then
3900	+	begin
3901	+	CharacterSetSize := IBFieldDef.CharacterSetSize;
3902	+	CharacterSetName := IBFieldDef.CharacterSetName;
3903	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3904	+	CodePage := IBFieldDef.CodePage;
3905	+	{$ENDIF}
3906	+	end;
3907	+	end
3908	+	else
3909	+	if(Fields[i] is TIBWideMemoField) then
3910	+	with TIBWideMemoField(Fields[i]) do
3911	+	begin
3912	+	IBFieldDef := GetFieldDef(FieldNo);
3913	+	if IBFieldDef <> nil then
3914	+	begin
3915	+	CharacterSetSize := IBFieldDef.CharacterSetSize;
3916	+	CharacterSetName := IBFieldDef.CharacterSetName;
3917	+	end;
3918	+	end
3919	+	end
3920	+	end;
3921	+
3922		begin
3923	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3095	<	if SetCursor then
3096	<	Screen.Cursor := crHourGlass;
3923	>	FBase.SetCursor;
3924		try
3925		ActivateConnection;
3926		ActivateTransaction;
#	Line 3106 | Line 3933 | begin
3933		if DefaultFields then
3934		CreateFields;
3935		BindFields(True);
3936	+	SetExtendedProperties;
3937		FCurrentRecord := -1;
3938		FQSelect.ExecQuery;
3939		FOpen := FQSelect.Open;
#	Line 3154 | Line 3982 | begin
3982		else
3983		FQSelect.ExecQuery;
3984		finally
3985	<	if SetCursor and (Screen.Cursor = crHourGlass) then
3158	<	Screen.Cursor := crDefault;
3985	>	FBase.RestoreCursor;
3986		end;
3987		end;
3988
#	Line 3163 | Line 3990 | procedure TIBCustomDataSet.InternalPost;
3990		var
3991		Qry: TIBSQL;
3992		Buff: PChar;
3166	–	SetCursor: Boolean;
3993		bInserting: Boolean;
3994		begin
3995	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3170	<	if SetCursor then
3171	<	Screen.Cursor := crHourGlass;
3995	>	FBase.SetCursor;
3996		try
3997		Buff := GetActiveBuf;
3998		CheckEditState;
#	Line 3206 | Line 4030 | begin
4030		if bInserting then
4031		Inc(FRecordCount);
4032		finally
4033	<	if SetCursor and (Screen.Cursor = crHourGlass) then
3210	<	Screen.Cursor := crDefault;
4033	>	FBase.RestoreCursor;
4034		end;
4035		end;
4036
4037		procedure TIBCustomDataSet.InternalRefresh;
4038		begin
4039	<	inherited;
4039	>	inherited InternalRefresh;
4040		InternalRefreshRow;
4041		end;
4042
#	Line 3227 | Line 4050 | begin
4050		result := FOpen;
4051		end;
4052
4053	+	procedure TIBCustomDataSet.Loaded;
4054	+	begin
4055	+	if assigned(FQSelect) then
4056	+	FBaseSQLSelect.assign(FQSelect.SQL);
4057	+	inherited Loaded;
4058	+	end;
4059	+
4060	+	procedure TIBCustomDataSet.Post;
4061	+	var CancelPost: boolean;
4062	+	begin
4063	+	CancelPost := false;
4064	+	if assigned(FOnValidatePost) then
4065	+	OnValidatePost(self,CancelPost);
4066	+	if CancelPost then
4067	+	Cancel
4068	+	else
4069	+	inherited Post;
4070	+	end;
4071	+
4072		function TIBCustomDataSet.Locate(const KeyFields: string; const KeyValues: Variant;
4073		Options: TLocateOptions): Boolean;
4074		var
4075	+	{$IFDEF NEW_TBOOKMARK }
4076	+	CurBookmark: TBookmark;
4077	+	{$ELSE}
4078		CurBookmark: string;
4079	+	{$ENDIF}
4080		begin
4081		DisableControls;
4082		try
#	Line 3248 | Line 4094 | function TIBCustomDataSet.Lookup(const K
4094		const ResultFields: string): Variant;
4095		var
4096		fl: TList;
4097	+	{$IFDEF NEW_TBOOKMARK }
4098	+	CurBookmark: TBookmark;
4099	+	{$ELSE}
4100		CurBookmark: string;
4101	+	{$ENDIF}
4102		begin
4103		DisableControls;
4104		fl := TList.Create;
#	Line 3301 | Line 4151 | end;
4151		procedure TIBCustomDataSet.InternalSetFieldData(Field: TField; Buffer: Pointer);
4152		var
4153		Buff, TmpBuff: PChar;
4154	+	MappedFieldPos: integer;
4155		begin
4156		Buff := GetActiveBuf;
4157		if Field.FieldNo < 0 then
#	Line 3317 | Line 4168 | begin
4168		begin
4169		{ If inserting, Adjust record position }
4170		AdjustRecordOnInsert(Buff);
4171	<	if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and
4172	<	(FMappedFieldPosition[Field.FieldNo - 1] <= rdFieldCount) then
4171	>	MappedFieldPos := FMappedFieldPosition[Field.FieldNo - 1];
4172	>	if (MappedFieldPos > 0) and
4173	>	(MappedFieldPos <= rdFieldCount) then
4174		begin
4175		Field.Validate(Buffer);
4176		if (Buffer = nil) or
4177		(Field is TIBStringField) and (PChar(Buffer)[0] = #0) then
4178	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull := True
4178	>	rdFields[MappedFieldPos].fdIsNull := True
4179		else begin
4180	<	Move(Buffer^, Buff[rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs],
4181	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataSize);
4182	<	if (rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_TEXT) or
4183	<	(rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_VARYING) then
4184	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataLength := StrLen(PChar(Buffer));
4185	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull := False;
4180	>	Move(Buffer^, Buff[rdFields[MappedFieldPos].fdDataOfs],
4181	>	rdFields[MappedFieldPos].fdDataSize);
4182	>	if (rdFields[MappedFieldPos].fdDataType = SQL_TEXT) or
4183	>	(rdFields[MappedFieldPos].fdDataType = SQL_VARYING) then
4184	>	rdFields[MappedFieldPos].fdDataLength := StrLen(PChar(Buffer));
4185	>	rdFields[MappedFieldPos].fdIsNull := False;
4186		if rdUpdateStatus = usUnmodified then
4187		begin
4188		if CachedUpdates then
#	Line 3354 | Line 4206 | begin
4206		end;
4207		end;
4208		if not (State in [dsCalcFields, dsFilter, dsNewValue]) then
4209	<	DataEvent(deFieldChange, Longint(Field));
4209	>	DataEvent(deFieldChange, PtrInt(Field));
4210		end;
4211
4212		procedure TIBCustomDataSet.SetRecNo(Value: Integer);
#	Line 3418 | Line 4270 | begin
4270		FillChar(Buffer[FRecordSize], CalcFieldsSize, 0);
4271		end;
4272
4273	+	procedure TIBCustomDataSet.ClearIBLinks;
4274	+	var i: integer;
4275	+	begin
4276	+	for i := FIBLinks.Count - 1 downto 0 do
4277	+	TIBControlLink(FIBLinks[i]).IBDataSet := nil;
4278	+	end;
4279	+
4280
4281		procedure TIBCustomDataSet.InternalUnPrepare;
4282		begin
#	Line 3425 | Line 4284 | begin
4284		begin
4285		CheckDatasetClosed;
4286		FieldDefs.Clear;
4287	+	FieldDefs.Updated := false;
4288		FInternalPrepared := False;
4289	+	Setlength(FAliasNameList,0);
4290		end;
4291		end;
4292
4293		procedure TIBCustomDataSet.InternalExecQuery;
4294		var
4295		DidActivate: Boolean;
3435	–	SetCursor: Boolean;
4296		begin
4297		DidActivate := False;
4298	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3439	<	if SetCursor then
3440	<	Screen.Cursor := crHourGlass;
4298	>	FBase.SetCursor;
4299		try
4300		ActivateConnection;
4301		DidActivate := ActivateTransaction;
#	Line 3454 | Line 4312 | begin
4312		finally
4313		if DidActivate then
4314		DeactivateTransaction;
4315	<	if SetCursor and (Screen.Cursor = crHourGlass) then
3458	<	Screen.Cursor := crDefault;
4315	>	FBase.RestoreCursor;
4316		end;
4317		end;
4318
#	Line 3464 | Line 4321 | begin
4321		Result := FQSelect.Handle;
4322		end;
4323
4324	+	function TIBCustomDataSet.GetParser: TSelectSQLParser;
4325	+	begin
4326	+	if not assigned(FParser) then
4327	+	FParser := CreateParser;
4328	+	Result := FParser
4329	+	end;
4330	+
4331	+	procedure TIBCustomDataSet.ResetParser;
4332	+	begin
4333	+	if assigned(FParser) then
4334	+	begin
4335	+	FParser.Free;
4336	+	FParser := nil;
4337	+	FQSelect.OnSQLChanged := nil; {Do not react to change}
4338	+	try
4339	+	FQSelect.SQL.Assign(FBaseSQLSelect);
4340	+	finally
4341	+	FQSelect.OnSQLChanged := SQLChanged;
4342	+	end;
4343	+	end;
4344	+	end;
4345	+
4346	+	function TIBCustomDataSet.HasParser: boolean;
4347	+	begin
4348	+	Result := not (csDesigning in ComponentState) and (FParser <> nil)
4349	+	end;
4350	+
4351	+	procedure TIBCustomDataSet.SetGenerateParamNames(AValue: Boolean);
4352	+	begin
4353	+	if FGenerateParamNames = AValue then Exit;
4354	+	FGenerateParamNames := AValue;
4355	+	Disconnect
4356	+	end;
4357	+
4358		procedure TIBCustomDataSet.InitRecord(Buffer: PChar);
4359		begin
4360		inherited InitRecord(Buffer);
#	Line 3482 | Line 4373 | end;
4373
4374		{ TIBDataSet IProviderSupport }
4375
4376	<	procedure TIBCustomDataSet.PSEndTransaction(Commit: Boolean);
4376	>	(*procedure TIBCustomDataSet.PSEndTransaction(Commit: Boolean);
4377		begin
4378		if Commit then
4379		Transaction.Commit else
#	Line 3645 | Line 4536 | begin
4536		if not FQSelect.Prepared then
4537		FQSelect.Prepare;
4538		Result := FQSelect.UniqueRelationName;
4539	<	end;
4539	>	end;*)
4540
4541		procedure TIBDataSet.BatchInput(InputObject: TIBBatchInput);
4542		begin
#	Line 3682 | Line 4573 | begin
4573		ActivateConnection;
4574		ActivateTransaction;
4575		InternalSetParamsFromCursor;
4576	<	Inherited;
4576	>	Inherited InternalOpen;
4577		end;
4578
4579		procedure TIBDataSet.SetFiltered(Value: Boolean);
#	Line 3710 | Line 4601 | end;
4601
4602		function TIBCustomDataSet.GetFieldData(Field: TField;
4603		Buffer: Pointer): Boolean;
4604	+	{$IFDEF TBCDFIELD_IS_BCD}
4605		var
4606		lTempCurr : System.Currency;
4607		begin
#	Line 3720 | Line 4612 | begin
4612		CurrToBCD(lTempCurr, TBCD(Buffer^), 32, Field.Size);
4613		end
4614		else
4615	+	{$ELSE}
4616	+	begin
4617	+	{$ENDIF}
4618		Result := InternalGetFieldData(Field, Buffer);
4619		end;
4620
#	Line 3733 | Line 4628 | begin
4628		end;
4629
4630		procedure TIBCustomDataSet.SetFieldData(Field: TField; Buffer: Pointer);
4631	+	{$IFDEF TDBDFIELD_IS_BCD}
4632		var
4633		lTempCurr : System.Currency;
4634		begin
4635	<	if Field.DataType = ftBCD then
4635	>	if (Field.DataType = ftBCD) and (Buffer <> nil) then
4636		begin
4637		BCDToCurr(TBCD(Buffer^), lTempCurr);
4638		InternalSetFieldData(Field, @lTempCurr);
4639		end
4640		else
4641	+	{$ELSE}
4642	+	begin
4643	+	{$ENDIF}
4644		InternalSetFieldData(Field, Buffer);
4645		end;
4646
#	Line 3765 | Line 4664 | end;
4664		destructor TIBDataSetUpdateObject.Destroy;
4665		begin
4666		FRefreshSQL.Free;
4667	<	inherited destroy;
4667	>	inherited Destroy;
4668		end;
4669
4670		procedure TIBDataSetUpdateObject.SetRefreshSQL(Value: TStrings);
#	Line 3773 | Line 4672 | begin
4672		FRefreshSQL.Assign(Value);
4673		end;
4674
4675	+	procedure TIBDataSetUpdateObject.InternalSetParams(Query: TIBSQL; buff: PChar);
4676	+	begin
4677	+	if not Assigned(DataSet) then Exit;
4678	+	DataSet.SetInternalSQLParams(Query, buff);
4679	+	end;
4680	+
4681	+	function TIBDSBlobStream.GetSize: Int64;
4682	+	begin
4683	+	Result := FBlobStream.BlobSize;
4684	+	end;
4685	+
4686		{ TIBDSBlobStream }
4687		constructor TIBDSBlobStream.Create(AField: TField; ABlobStream: TIBBlobStream;
4688		Mode: TBlobStreamMode);
#	Line 3781 | Line 4691 | begin
4691		FBlobStream := ABlobStream;
4692		FBlobStream.Seek(0, soFromBeginning);
4693		if (Mode = bmWrite) then
4694	+	begin
4695		FBlobStream.Truncate;
4696	+	TIBCustomDataSet(FField.DataSet).RecordModified(True);
4697	+	TBlobField(FField).Modified := true;
4698	+	FHasWritten := true;
4699	+	end;
4700	+	end;
4701	+
4702	+	destructor TIBDSBlobStream.Destroy;
4703	+	begin
4704	+	if FHasWritten then
4705	+	TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
4706	+	inherited Destroy;
4707		end;
4708
4709		function TIBDSBlobStream.Read(var Buffer; Count: Longint): Longint;
#	Line 3804 | Line 4726 | begin
4726		if not (FField.DataSet.State in [dsEdit, dsInsert]) then
4727		IBError(ibxeNotEditing, [nil]);
4728		TIBCustomDataSet(FField.DataSet).RecordModified(True);
4729	+	TBlobField(FField).Modified := true;
4730		result := FBlobStream.Write(Buffer, Count);
4731	<	TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, Longint(FField));
4731	>	FHasWritten := true;
4732	>	{  TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
4733	>	Removed as this caused a seek to beginning of the blob stream thus corrupting
4734	>	the blob stream. Moved to the destructor i.e. called after blob written}
4735	>	end;
4736	>
4737	>	{ TIBGenerator }
4738	>
4739	>	procedure TIBGenerator.SetIncrement(const AValue: integer);
4740	>	begin
4741	>	if AValue < 0 then
4742	>	raise Exception.Create('A Generator Increment cannot be negative');
4743	>	FIncrement := AValue
4744	>	end;
4745	>
4746	>	function TIBGenerator.GetNextValue(ADatabase: TIBDatabase;
4747	>	ATransaction: TIBTransaction): integer;
4748	>	begin
4749	>	with TIBSQL.Create(nil) do
4750	>	try
4751	>	Database := ADatabase;
4752	>	Transaction := ATransaction;
4753	>	if not assigned(Database) then
4754	>	IBError(ibxeCannotSetDatabase,[]);
4755	>	if not assigned(Transaction) then
4756	>	IBError(ibxeCannotSetTransaction,[]);
4757	>	with Transaction do
4758	>	if not InTransaction then StartTransaction;
4759	>	SQL.Text := Format('Select Gen_ID(%s,%d) as ID From RDB$Database',[FGeneratorName,Increment]);
4760	>	Prepare;
4761	>	ExecQuery;
4762	>	try
4763	>	Result := FieldByName('ID').AsInteger
4764	>	finally
4765	>	Close
4766	>	end;
4767	>	finally
4768	>	Free
4769	>	end;
4770	>	end;
4771	>
4772	>	constructor TIBGenerator.Create(Owner: TIBCustomDataSet);
4773	>	begin
4774	>	FOwner := Owner;
4775	>	FIncrement := 1;
4776		end;
4777
4778	+
4779	+	procedure TIBGenerator.Apply;
4780	+	begin
4781	+	if (FGeneratorName <> '') and (FFieldName <> '') and Owner.FieldByName(FFieldName).IsNull then
4782	+	Owner.FieldByName(FFieldName).AsInteger := GetNextValue(Owner.Database,Owner.Transaction);
4783	+	end;
4784	+
4785	+
4786		end.

Diff Legend

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