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 43 by tony, Thu Sep 22 17:10:15 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 73 | Line 98 | type
98		fdDataSize: Short;
99		fdDataLength: Short;
100		fdDataOfs: Integer;
101	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
102	+	fdCodePage: TSystemCodePage;
103	+	{$ENDIF}
104		end;
105		PFieldData = ^TFieldData;
106
#	Line 88 | Line 116 | type
116		TRecordData = record
117		rdBookmarkFlag: TBookmarkFlag;
118		rdFieldCount: Short;
119	<	rdRecordNumber: Long;
119	>	rdRecordNumber: Integer;
120		rdCachedUpdateStatus: TCachedUpdateStatus;
121		rdUpdateStatus: TUpdateStatus;
122		rdSavedOffset: DWORD;
#	Line 100 | Line 128 | type
128		{ TIBStringField allows us to have strings longer than 8196 }
129
130		TIBStringField = class(TStringField)
131	+	private
132	+	FCharacterSetName: RawByteString;
133	+	FCharacterSetSize: integer;
134	+	protected
135	+	function GetDefaultWidth: Longint; override;
136		public
137	<	constructor create(AOwner: TComponent); override;
137	>	constructor Create(aOwner: TComponent); override;
138		class procedure CheckTypeSize(Value: Integer); override;
139		function GetAsString: string; override;
140		function GetAsVariant: Variant; override;
141		function GetValue(var Value: string): Boolean;
142		procedure SetAsString(const Value: string); override;
143	+	property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
144	+	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
145	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
146	+	private
147	+	FCodePage: TSystemCodePage;
148	+	public
149	+	property CodePage: TSystemCodePage read FCodePage write FCodePage;
150	+	{$ENDIF}
151		end;
152
153		{ TIBBCDField }
#	Line 129 | Line 170 | type
170		property Size default 8;
171		end;
172
173	+	{TIBMemoField}
174	+	{Allows us to show truncated text in DBGrids and anything else that uses
175	+	DisplayText}
176	+
177	+	TIBMemoField = class(TMemoField)
178	+	private
179	+	FCharacterSetName: RawByteString;
180	+	FCharacterSetSize: integer;
181	+	FDisplayTextAsClassName: boolean;
182	+	function GetTruncatedText: string;
183	+	protected
184	+	function GetAsString: string; override;
185	+	function GetDefaultWidth: Longint; override;
186	+	procedure GetText(var AText: string; ADisplayText: Boolean); override;
187	+	procedure SetAsString(const AValue: string); override;
188	+	public
189	+	constructor Create(AOwner: TComponent); override;
190	+	property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
191	+	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
192	+	published
193	+	property DisplayTextAsClassName: boolean read FDisplayTextAsClassName
194	+	write FDisplayTextAsClassName;
195	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
196	+	private
197	+	FCodePage: TSystemCodePage;
198	+	FFCodePage: TSystemCodePage;
199	+	public
200	+	property CodePage: TSystemCodePage read FFCodePage write FFCodePage;
201	+	{$ENDIF}
202	+	end;
203	+
204		TIBDataLink = class(TDetailDataLink)
205		private
206		FDataSet: TIBCustomDataSet;
#	Line 142 | Line 214 | type
214		destructor Destroy; override;
215		end;
216
217	+	TIBGeneratorApplyOnEvent = (gaeOnNewRecord,gaeOnPostRecord);
218	+
219	+	{ TIBGenerator }
220	+
221	+	TIBGenerator = class(TPersistent)
222	+	private
223	+	FOwner: TIBCustomDataSet;
224	+	FApplyOnEvent: TIBGeneratorApplyOnEvent;
225	+	FFieldName: string;
226	+	FGeneratorName: string;
227	+	FIncrement: integer;
228	+	procedure SetIncrement(const AValue: integer);
229	+	protected
230	+	function GetNextValue(ADatabase: TIBDatabase; ATransaction: TIBTransaction): integer;
231	+	public
232	+	constructor Create(Owner: TIBCustomDataSet);
233	+	procedure Apply;
234	+	property Owner: TIBCustomDataSet read FOwner;
235	+	published
236	+	property Generator: string read FGeneratorName write FGeneratorName;
237	+	property Field: string read FFieldName write FFieldName;
238	+	property Increment: integer read FIncrement write SetIncrement default 1;
239	+	property ApplyOnEvent: TIBGeneratorApplyOnEvent read FApplyOnEvent write FApplyOnEvent;
240	+	end;
241	+
242	+	{TIBControlLink - Allows IB Aware controls to react to dataset state changes}
243	+
244	+	TIBControlLink = class
245	+	private
246	+	FTIBDataSet: TIBCustomDataSet;
247	+	procedure SetIBDataSet(AValue: TIBCustomDataSet);
248	+	protected
249	+	procedure UpdateSQL(Sender: TObject); virtual;
250	+	procedure UpdateParams(Sender: TObject); virtual;
251	+	public
252	+	destructor Destroy; override;
253	+	property IBDataSet: TIBCustomDataSet read FTIBDataSet write SetIBDataSet;
254	+	end;
255	+
256	+	TIBAutoCommit = (acDisabled, acCommitRetaining);
257	+
258		{ TIBCustomDataSet }
259		TIBUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApply, uaApplied);
260
261		TIBUpdateErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
262	<	UpdateKind: TUpdateKind; var UpdateAction: TIBUpdateAction)
262	>	UpdateKind: TUpdateKind; var TheUpdateAction: TIBUpdateAction)
263		of object;
264		TIBUpdateRecordEvent = procedure(DataSet: TDataSet; UpdateKind: TUpdateKind;
265		var UpdateAction: TIBUpdateAction) of object;
266
267		TIBUpdateRecordTypes = set of TCachedUpdateStatus;
268
269	+	TDataSetCloseAction = (dcDiscardChanges, dcSaveChanges);
270	+
271	+	TOnValidatePost = procedure (Sender: TObject; var CancelPost: boolean) of object;
272	+
273		TIBCustomDataSet = class(TDataset)
274		private
275	+	FAutoCommit: TIBAutoCommit;
276	+	FGenerateParamNames: Boolean;
277	+	FGeneratorField: TIBGenerator;
278		FNeedsRefresh: Boolean;
279		FForcedRefresh: Boolean;
280		FDidActivate: Boolean;
#	Line 179 | Line 299 | type
299		FDeletedRecords: Long;
300		FModelBuffer,
301		FOldBuffer: PChar;
302	+	FOnValidatePost: TOnValidatePost;
303		FOpen: Boolean;
304		FInternalPrepared: Boolean;
305		FQDelete,
#	Line 189 | Line 310 | type
310		FRecordBufferSize: Integer;
311		FRecordCount: Integer;
312		FRecordSize: Integer;
313	+	FDataSetCloseAction: TDataSetCloseAction;
314		FUniDirectional: Boolean;
315		FUpdateMode: TUpdateMode;
316		FUpdateObject: TIBDataSetUpdateObject;
#	Line 206 | Line 328 | type
328		FBeforeTransactionEnd,
329		FAfterTransactionEnd,
330		FTransactionFree: TNotifyEvent;
331	<
331	>	FAliasNameMap: array of string;
332	>	FAliasNameList: array of string;
333	>	FBaseSQLSelect: TStrings;
334	>	FParser: TSelectSQLParser;
335	>	FCloseAction: TTransactionAction;
336	>	FInTransactionEnd: boolean;
337	>	FIBLinks: TList;
338		function GetSelectStmtHandle: TISC_STMT_HANDLE;
339		procedure SetUpdateMode(const Value: TUpdateMode);
340		procedure SetUpdateObject(Value: TIBDataSetUpdateObject);
#	Line 219 | Line 347 | type
347		function CanRefresh: Boolean;
348		procedure CheckEditState;
349		procedure ClearBlobCache;
350	+	procedure ClearIBLinks;
351		procedure CopyRecordBuffer(Source, Dest: Pointer);
352		procedure DoBeforeDatabaseDisconnect(Sender: TObject);
353		procedure DoAfterDatabaseDisconnect(Sender: TObject);
354		procedure DoDatabaseFree(Sender: TObject);
355	<	procedure DoBeforeTransactionEnd(Sender: TObject);
355	>	procedure DoBeforeTransactionEnd(Sender: TObject; Action: TTransactionAction);
356		procedure DoAfterTransactionEnd(Sender: TObject);
357		procedure DoTransactionFree(Sender: TObject);
358		procedure FetchCurrentRecordToBuffer(Qry: TIBSQL; RecordNumber: Integer;
#	Line 239 | Line 368 | type
368		function GetModifySQL: TStrings;
369		function GetTransaction: TIBTransaction;
370		function GetTRHandle: PISC_TR_HANDLE;
371	<	procedure InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer);
371	>	function GetParser: TSelectSQLParser;
372	>	procedure InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer); virtual;
373		function InternalLocate(const KeyFields: string; const KeyValues: Variant;
374		Options: TLocateOptions): Boolean; virtual;
375	<	procedure InternalPostRecord(Qry: TIBSQL; Buff: Pointer);
376	<	procedure InternalRevertRecord(RecordNumber: Integer);
375	>	procedure InternalPostRecord(Qry: TIBSQL; Buff: Pointer); virtual;
376	>	procedure InternalRevertRecord(RecordNumber: Integer); virtual;
377		function IsVisible(Buffer: PChar): Boolean;
378	+	procedure RegisterIBLink(Sender: TIBControlLink);
379	+	procedure UnRegisterIBLink(Sender: TIBControlLink);
380		procedure SaveOldBuffer(Buffer: PChar);
381		procedure SetBufferChunks(Value: Integer);
382		procedure SetDatabase(Value: TIBDatabase);
#	Line 258 | Line 390 | type
390		procedure SetUpdateRecordTypes(Value: TIBUpdateRecordTypes);
391		procedure SetUniDirectional(Value: Boolean);
392		procedure RefreshParams;
261	–	procedure SQLChanging(Sender: TObject); virtual;
393		function AdjustPosition(FCache: PChar; Offset: DWORD;
394	<	Origin: Integer): Integer;
394	>	Origin: Integer): DWORD;
395		procedure ReadCache(FCache: PChar; Offset: DWORD; Origin: Integer;
396		Buffer: PChar);
397		procedure ReadRecordCache(RecordNumber: Integer; Buffer: PChar;
#	Line 269 | Line 400 | type
400		Buffer: PChar);
401		procedure WriteRecordCache(RecordNumber: Integer; Buffer: PChar);
402		function InternalGetRecord(Buffer: PChar; GetMode: TGetMode;
403	<	DoCheck: Boolean): TGetResult;
403	>	DoCheck: Boolean): TGetResult; virtual;
404
405		protected
406		procedure ActivateConnection;
#	Line 277 | Line 408 | type
408		procedure DeactivateTransaction;
409		procedure CheckDatasetClosed;
410		procedure CheckDatasetOpen;
411	+	function CreateParser: TSelectSQLParser; virtual;
412	+	procedure FieldDefsFromQuery(SourceQuery: TIBSQL);
413		function GetActiveBuf: PChar;
414	<	procedure InternalBatchInput(InputObject: TIBBatchInput);
415	<	procedure InternalBatchOutput(OutputObject: TIBBatchOutput);
414	>	procedure InternalBatchInput(InputObject: TIBBatchInput); virtual;
415	>	procedure InternalBatchOutput(OutputObject: TIBBatchOutput); virtual;
416		procedure InternalPrepare; virtual;
417		procedure InternalUnPrepare; virtual;
418		procedure InternalExecQuery; virtual;
419		procedure InternalRefreshRow; virtual;
420	<	procedure InternalSetParamsFromCursor;
420	>	procedure InternalSetParamsFromCursor; virtual;
421		procedure CheckNotUniDirectional;
422	+	procedure SQLChanging(Sender: TObject); virtual;
423	+	procedure SQLChanged(Sender: TObject); virtual;
424
425	<	{ IProviderSupport }
425	>	(*    { IProviderSupport }
426		procedure PSEndTransaction(Commit: Boolean); override;
427		function PSExecuteStatement(const ASQL: string; AParams: TParams;
428		ResultSet: Pointer = nil): Integer; override;
#	Line 300 | Line 435 | type
435		procedure PSStartTransaction; override;
436		procedure PSReset; override;
437		function PSUpdateRecord(UpdateKind: TUpdateKind; Delta: TDataSet): Boolean; override;
438	<
438	>	*)
439		{ TDataSet support }
440		procedure InternalInsert; override;
441		procedure InitRecord(Buffer: PChar); override;
#	Line 309 | Line 444 | type
444		procedure ClearCalcFields(Buffer: PChar); override;
445		function AllocRecordBuffer: PChar; override;
446		procedure DoBeforeDelete; override;
447	+	procedure DoAfterDelete; override;
448		procedure DoBeforeEdit; override;
449	+	procedure DoAfterEdit; override;
450		procedure DoBeforeInsert; override;
451	+	procedure DoAfterInsert; override;
452	+	procedure DoBeforeClose; override;
453	+	procedure DoBeforeOpen; override;
454	+	procedure DoBeforePost; override;
455	+	procedure DoAfterPost; override;
456		procedure FreeRecordBuffer(var Buffer: PChar); override;
457		procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
458		function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
459		function GetCanModify: Boolean; override;
460		function GetDataSource: TDataSource; override;
461	+	function GetDBAliasName(FieldNo: integer): string;
462	+	function GetFieldDefFromAlias(aliasName: string): TFieldDef;
463		function GetFieldClass(FieldType: TFieldType): TFieldClass; override;
464		function GetRecNo: Integer; override;
465		function GetRecord(Buffer: PChar; GetMode: TGetMode;
466		DoCheck: Boolean): TGetResult; override;
467		function GetRecordCount: Integer; override;
468		function GetRecordSize: Word; override;
469	+	procedure InternalAutoCommit;
470		procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override;
471		procedure InternalCancel; override;
472		procedure InternalClose; override;
473		procedure InternalDelete; override;
474		procedure InternalFirst; override;
475	<	function InternalGetFieldData(Field: TField; Buffer: Pointer): Boolean;
475	>	function InternalGetFieldData(Field: TField; Buffer: Pointer): Boolean; virtual;
476		procedure InternalGotoBookmark(Bookmark: Pointer); override;
477		procedure InternalHandleException; override;
478		procedure InternalInitFieldDefs; override;
#	Line 336 | Line 481 | type
481		procedure InternalOpen; override;
482		procedure InternalPost; override;
483		procedure InternalRefresh; override;
484	<	procedure InternalSetFieldData(Field: TField; Buffer: Pointer);
484	>	procedure InternalSetFieldData(Field: TField; Buffer: Pointer); virtual;
485		procedure InternalSetToRecord(Buffer: PChar); override;
486		function IsCursorOpen: Boolean; override;
487	+	procedure Loaded; override;
488		procedure ReQuery;
489		procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
490		procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
491		procedure SetCachedUpdates(Value: Boolean);
492		procedure SetDataSource(Value: TDataSource);
493	+	procedure SetGenerateParamNames(AValue: Boolean); virtual;
494		procedure SetFieldData(Field : TField; Buffer : Pointer); override;
495		procedure SetFieldData(Field : TField; Buffer : Pointer;
496		NativeFormat : Boolean); overload; override;
#	Line 351 | Line 498 | type
498
499		protected
500		{Likely to be made public by descendant classes}
501	+	property AutoCommit: TIBAutoCommit read FAutoCommit write FAutoCommit default acDisabled;
502		property SQLParams: TIBXSQLDA read GetSQLParams;
503		property Params: TIBXSQLDA read GetSQLParams;
504		property InternalPrepared: Boolean read FInternalPrepared;
#	Line 366 | Line 514 | type
514		property BufferChunks: Integer read FBufferChunks write SetBufferChunks;
515		property CachedUpdates: Boolean read FCachedUpdates write SetCachedUpdates;
516		property UniDirectional: Boolean read FUniDirectional write SetUniDirectional default False;
517	+	property GeneratorField: TIBGenerator read FGeneratorField write FGeneratorField;
518		property DeleteSQL: TStrings read GetDeleteSQL write SetDeleteSQL;
519		property InsertSQL: TStrings read GetInsertSQL write SetInsertSQL;
520		property RefreshSQL: TStrings read GetRefreshSQL write SetRefreshSQL;
#	Line 373 | Line 522 | type
522		property ModifySQL: TStrings read GetModifySQL write SetModifySQL;
523		property UpdateMode: TUpdateMode read FUpdateMode write SetUpdateMode default upWhereAll;
524		property ParamCheck: Boolean read FParamCheck write FParamCheck default True;
525	+	property Parser: TSelectSQLParser read GetParser;
526	+	property BaseSQLSelect: TStrings read FBaseSQLSelect;
527
528		property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect
529		write FBeforeDatabaseDisconnect;
#	Line 386 | Line 537 | type
537		write FAfterTransactionEnd;
538		property TransactionFree: TNotifyEvent read FTransactionFree
539		write FTransactionFree;
540	+	property OnValidatePost: TOnValidatePost read FOnValidatePost write FOnValidatePost;
541
542		public
543		constructor Create(AOwner: TComponent); override;
#	Line 393 | Line 545 | type
545		procedure ApplyUpdates;
546		function CachedUpdateStatus: TCachedUpdateStatus;
547		procedure CancelUpdates;
548	+	function GetFieldPosition(AliasName: string): integer;
549		procedure FetchAll;
550		function LocateNext(const KeyFields: string; const KeyValues: Variant;
551		Options: TLocateOptions): Boolean;
552		procedure RecordModified(Value: Boolean);
553		procedure RevertRecord;
554		procedure Undelete;
555	+	procedure ResetParser; virtual;
556	+	function HasParser: boolean;
557
558		{ TDataSet support methods }
559		function BookmarkValid(Bookmark: TBookmark): Boolean; override;
#	Line 406 | Line 561 | type
561		function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
562		function GetCurrentRecord(Buffer: PChar): Boolean; override;
563		function GetFieldData(Field : TField; Buffer : Pointer) : Boolean; overload; override;
564	<	function GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; overload; override;
564	>	function GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; overload; (*override;*)
565		function GetFieldData(Field : TField; Buffer : Pointer;
566		NativeFormat : Boolean) : Boolean; overload; override;
567	+	property GenerateParamNames: Boolean read FGenerateParamNames write SetGenerateParamNames;
568		function Locate(const KeyFields: string; const KeyValues: Variant;
569		Options: TLocateOptions): Boolean; override;
570		function Lookup(const KeyFields: string; const KeyValues: Variant;
571		const ResultFields: string): Variant; override;
572		function UpdateStatus: TUpdateStatus; override;
573		function IsSequenced: Boolean; override;
574	<
574	>	procedure Post; override;
575	>	function ParamByName(ParamName: String): TIBXSQLVAR;
576		property DBHandle: PISC_DB_HANDLE read GetDBHandle;
577		property TRHandle: PISC_TR_HANDLE read GetTRHandle;
578		property UpdateObject: TIBDataSetUpdateObject read FUpdateObject write SetUpdateObject;
579		property UpdatesPending: Boolean read FUpdatesPending;
580		property UpdateRecordTypes: TIBUpdateRecordTypes read FUpdateRecordTypes
581		write SetUpdateRecordTypes;
582	+	property DataSetCloseAction: TDataSetCloseAction
583	+	read FDataSetCloseAction write FDataSetCloseAction;
584
585		published
586		property Database: TIBDatabase read GetDatabase write SetDatabase;
#	Line 430 | Line 589 | type
589		property ForcedRefresh: Boolean read FForcedRefresh
590		write FForcedRefresh default False;
591		property AutoCalcFields;
433	–	property ObjectView default False;
592
593		property AfterCancel;
594		property AfterClose;
#	Line 461 | Line 619 | type
619		write FOnUpdateRecord;
620		end;
621
622	<	TIBDataSet = class(TIBCustomDataSet)
622	>	TIBParserDataSet = class(TIBCustomDataSet)
623	>	public
624	>	property Parser;
625	>	end;
626	>
627	>	TIBDataSet = class(TIBParserDataSet)
628		private
629		function GetPrepared: Boolean;
630
#	Line 486 | Line 649 | type
649		property QModify;
650		property StatementType;
651		property SelectStmtHandle;
652	+	property BaseSQLSelect;
653
654		published
655		{ TIBCustomDataSet }
656	+	property AutoCommit;
657		property BufferChunks;
658		property CachedUpdates;
659		property DeleteSQL;
#	Line 496 | Line 661 | type
661		property RefreshSQL;
662		property SelectSQL;
663		property ModifySQL;
664	+	property GeneratorField;
665	+	property GenerateParamNames;
666		property ParamCheck;
667		property UniDirectional;
668		property Filtered;
669	+	property DataSetCloseAction;
670
671		property BeforeDatabaseDisconnect;
672		property AfterDatabaseDisconnect;
#	Line 534 | Line 702 | type
702		property OnFilterRecord;
703		property OnNewRecord;
704		property OnPostError;
705	+	property OnValidatePost;
706		end;
707
708		{ TIBDSBlobStream }
709		TIBDSBlobStream = class(TStream)
710	+	private
711	+	FHasWritten: boolean;
712		protected
713		FField: TField;
714		FBlobStream: TIBBlobStream;
715	+	function  GetSize: Int64; override;
716		public
717		constructor Create(AField: TField; ABlobStream: TIBBlobStream;
718		Mode: TBlobStreamMode);
719	+	destructor Destroy; override;
720		function Read(var Buffer; Count: Longint): Longint; override;
721		function Seek(Offset: Longint; Origin: Word): Longint; override;
722		procedure SetSize(NewSize: Longint); override;
#	Line 568 | Line 741 | DefaultFieldClasses: array[TFieldType] o
741		TVarBytesField,     { ftVarBytes }
742		TAutoIncField,      { ftAutoInc }
743		TBlobField,         { ftBlob }
744	<	TMemoField,         { ftMemo }
744	>	TIBMemoField,       { ftMemo }
745		TGraphicField,      { ftGraphic }
746		TBlobField,         { ftFmtMemo }
747		TBlobField,         { ftParadoxOle }
#	Line 576 | Line 749 | DefaultFieldClasses: array[TFieldType] o
749		TBlobField,         { ftTypedBinary }
750		nil,                { ftCursor }
751		TStringField,       { ftFixedChar }
752	<	nil, {TWideStringField } { ftWideString }
752	>	nil,    { ftWideString }
753		TLargeIntField,     { ftLargeInt }
754	+	nil,          { ftADT }
755	+	nil,        { ftArray }
756	+	nil,    { ftReference }
757	+	nil,     { ftDataSet }
758	+	TBlobField,         { ftOraBlob }
759	+	TMemoField,         { ftOraClob }
760	+	TVariantField,      { ftVariant }
761	+	nil,    { ftInterface }
762	+	nil,     { ftIDispatch }
763	+	TGuidField,        { ftGuid }
764	+	TDateTimeField,    {ftTimestamp}
765	+	TIBBCDField,       {ftFMTBcd}
766	+	nil,  {ftFixedWideChar}
767	+	nil);   {ftWideMemo}
768	+	(*
769		TADTField,          { ftADT }
770		TArrayField,        { ftArray }
771		TReferenceField,    { ftReference }
#	Line 587 | Line 775 | DefaultFieldClasses: array[TFieldType] o
775		TVariantField,      { ftVariant }
776		TInterfaceField,    { ftInterface }
777		TIDispatchField,     { ftIDispatch }
778	<	TGuidField);        { ftGuid }
779	<	var
780	<	CreateProviderProc: function(DataSet: TIBCustomDataSet): IProvider = nil;
778	>	TGuidField);        { ftGuid } *)
779	>	(*var
780	>	CreateProviderProc: function(DataSet: TIBCustomDataSet): IProvider = nil;*)
781
782		implementation
783
784	<	uses IBIntf, IBQuery;
784	>	uses IBIntf, Variants, FmtBCD, LazUTF8, IBCodePage;
785	>
786	>	const FILE_BEGIN = 0;
787	>	FILE_CURRENT = 1;
788	>	FILE_END = 2;
789
790		type
791
#	Line 612 | Line 804 | type
804		NextRelation : TRelationNode;
805		end;
806
807	+	{Extended Field Def for character set info}
808	+
809	+	{ TIBFieldDef }
810	+
811	+	TIBFieldDef = class(TFieldDef)
812	+	private
813	+	FCharacterSetName: RawByteString;
814	+	FCharacterSetSize: integer;
815	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
816	+	FCodePage: TSystemCodePage;
817	+	{$ENDIF}
818	+	published
819	+	property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
820	+	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
821	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
822	+	property CodePage: TSystemCodePage read FCodePage write FCodePage;
823	+	{$ENDIF}
824	+	end;
825	+
826	+
827	+	{  Copied from LCLProc in order to avoid LCL dependency
828	+
829	+	Ensures the covenient look of multiline string
830	+	when displaying it in the single line
831	+	* Replaces CR and LF with spaces
832	+	* Removes duplicate spaces
833	+	}
834	+	function TextToSingleLine(const AText: string): string;
835	+	var
836	+	str: string;
837	+	i, wstart, wlen: Integer;
838	+	begin
839	+	str := Trim(AText);
840	+	wstart := 0;
841	+	wlen := 0;
842	+	i := 1;
843	+	while i < Length(str) - 1 do
844	+	begin
845	+	if (str[i] in [' ', #13, #10]) then
846	+	begin
847	+	if (wstart = 0) then
848	+	begin
849	+	wstart := i;
850	+	wlen := 1;
851	+	end else
852	+	Inc(wlen);
853	+	end else
854	+	begin
855	+	if wstart > 0 then
856	+	begin
857	+	str[wstart] := ' ';
858	+	Delete(str, wstart+1, wlen-1);
859	+	Dec(i, wlen-1);
860	+	wstart := 0;
861	+	end;
862	+	end;
863	+	Inc(i);
864	+	end;
865	+	Result := str;
866	+	end;
867	+
868	+	{ TIBMemoField }
869	+
870	+	function TIBMemoField.GetTruncatedText: string;
871	+	begin
872	+	Result := GetAsString;
873	+
874	+	if Result <> '' then
875	+	begin
876	+	case CharacterSetSize of
877	+	1:
878	+	if DisplayWidth = 0 then
879	+	Result := TextToSingleLine(Result)
880	+	else
881	+	if Length(Result) > DisplayWidth then {Show truncation with elipses}
882	+	Result := TextToSingleLine(system.copy(Result,1,DisplayWidth-3)) + '...';
883	+
884	+	{2: case 2 ignored. This should be handled by TIBWideMemo}
885	+
886	+	3, {Assume UNICODE_FSS is really UTF8}
887	+	4: {Include GB18030 - assuming UTF8 routine work for this codeset}
888	+	if DisplayWidth = 0 then
889	+	Result := ValidUTF8String(TextToSingleLine(Result))
890	+	else
891	+	if UTF8Length(Result) > DisplayWidth then {Show truncation with elipses}
892	+	Result := ValidUTF8String(TextToSingleLine(UTF8Copy(Result,1,DisplayWidth-3))) + '...';
893	+	end;
894	+	end
895	+	end;
896	+
897	+	function TIBMemoField.GetAsString: string;
898	+	var s: RawByteString;
899	+	begin
900	+	s := inherited GetAsString;
901	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
902	+	SetCodePage(s,CodePage,false);
903	+	if (CodePage <> CP_NONE) and (CodePage <> CP_UTF8) then
904	+	SetCodePage(s,CP_UTF8,true);  {LCL only accepts UTF8}
905	+	{$ENDIF}
906	+	Result := s;
907	+	end;
908	+
909	+	function TIBMemoField.GetDefaultWidth: Longint;
910	+	begin
911	+	if DisplayTextAsClassName then
912	+	Result := inherited
913	+	else
914	+	Result := 128;
915	+	end;
916	+
917	+	procedure TIBMemoField.GetText(var AText: string; ADisplayText: Boolean);
918	+	begin
919	+	if ADisplayText then
920	+	begin
921	+	if not DisplayTextAsClassName and (CharacterSetName <> '') then
922	+	AText := GetTruncatedText
923	+	else
924	+	inherited GetText(AText, ADisplayText);
925	+	end
926	+	else
927	+	AText := GetAsString;
928	+	end;
929	+
930	+	procedure TIBMemoField.SetAsString(const AValue: string);
931	+	var s: RawByteString;
932	+	begin
933	+	s := AValue;
934	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
935	+	if StringCodePage(Value) <> CodePage then
936	+	SetCodePage(s,CodePage,CodePage<>CP_NONE);
937	+	{$ENDIF}
938	+	inherited SetAsString(s);
939	+	end;
940	+
941	+	constructor TIBMemoField.Create(AOwner: TComponent);
942	+	begin
943	+	inherited Create(AOwner);
944	+	BlobType := ftMemo;
945	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
946	+	FCodePage := CP_NONE;
947	+	{$ENDIF}
948	+	end;
949	+
950	+	{ TIBControlLink }
951	+
952	+	destructor TIBControlLink.Destroy;
953	+	begin
954	+	IBDataSet := nil;
955	+	inherited Destroy;
956	+	end;
957	+
958	+	procedure TIBControlLink.UpdateParams(Sender: TObject);
959	+	begin
960	+
961	+	end;
962	+
963	+	procedure TIBControlLink.UpdateSQL(Sender: TObject);
964	+	begin
965	+
966	+	end;
967	+
968	+	procedure TIBControlLink.SetIBDataSet(AValue: TIBCustomDataSet);
969	+	begin
970	+	if FTIBDataSet = AValue then Exit;
971	+	if IBDataSet <> nil then
972	+	IBDataSet.UnRegisterIBLink(self);
973	+	FTIBDataSet := AValue;
974	+	if IBDataSet <> nil then
975	+	IBDataSet.RegisterIBLink(self);
976	+	end;
977	+
978
979		{ TIBStringField}
980
981	<	constructor TIBStringField.Create(AOwner: TComponent);
981	>	function TIBStringField.GetDefaultWidth: Longint;
982		begin
983	<	inherited;
983	>	Result := Size div CharacterSetSize;
984	>	end;
985	>
986	>	constructor TIBStringField.Create(aOwner: TComponent);
987	>	begin
988	>	inherited Create(aOwner);
989	>	FCharacterSetSize := 1;
990	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
991	>	FCodePage := CP_NONE;
992	>	{$ENDIF}
993		end;
994
995		class procedure TIBStringField.CheckTypeSize(Value: Integer);
#	Line 640 | Line 1012 | end;
1012		function TIBStringField.GetValue(var Value: string): Boolean;
1013		var
1014		Buffer: PChar;
1015	+	s: RawByteString;
1016	+	//  i: integer;
1017		begin
1018		Buffer := nil;
1019		IBAlloc(Buffer, 0, Size + 1);
#	Line 647 | Line 1021 | begin
1021		Result := GetData(Buffer);
1022		if Result then
1023		begin
1024	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1025	+	s := string(Buffer);
1026	+	SetCodePage(s,CodePage,false);
1027	+	if (CodePage <> CP_NONE) and (CodePage <> CP_UTF8) then
1028	+	SetCodePage(s,CP_UTF8,true);  {LCL only accepts UTF8}
1029	+	Value := s;
1030	+	(*      write(FieldName,': ', StringCodePage(Value),', ',Value,' ');
1031	+	for i := 1 to Length(Value) do
1032	+	write(Format('%x ',[byte(Value[i])]));
1033	+	writeln;*)
1034	+	{$ELSE}
1035		Value := string(Buffer);
1036	+	{$ENDIF}
1037		if Transliterate and (Value <> '') then
1038		DataSet.Translate(PChar(Value), PChar(Value), False);
1039		end
#	Line 659 | Line 1045 | end;
1045		procedure TIBStringField.SetAsString(const Value: string);
1046		var
1047		Buffer: PChar;
1048	+	s: RawByteString;
1049		begin
1050		Buffer := nil;
1051		IBAlloc(Buffer, 0, Size + 1);
1052		try
1053	<	StrLCopy(Buffer, PChar(Value), Size);
1053	>	s := Value;
1054	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1055	>	if StringCodePage(s) <> CodePage then
1056	>	SetCodePage(s,CodePage,CodePage<>CP_NONE);
1057	>	{$ENDIF}
1058	>	StrLCopy(Buffer, PChar(s), Size);
1059		if Transliterate then
1060		DataSet.Translate(Buffer, Buffer, True);
1061		SetData(Buffer);
#	Line 672 | Line 1064 | begin
1064		end;
1065		end;
1066
1067	+
1068		{ TIBBCDField }
1069
1070		constructor TIBBCDField.Create(AOwner: TComponent);
#	Line 714 | Line 1107 | end;
1107
1108		function TIBBCDField.GetDataSize: Integer;
1109		begin
1110	+	{$IFDEF TBCDFIELD_IS_BCD}
1111		Result := 8;
1112	+	{$ELSE}
1113	+	Result := inherited GetDataSize
1114	+	{$ENDIF}
1115		end;
1116
1117		{ TIBDataLink }
#	Line 728 | Line 1125 | end;
1125		destructor TIBDataLink.Destroy;
1126		begin
1127		FDataSet.FDataLink := nil;
1128	<	inherited;
1128	>	inherited Destroy;
1129		end;
1130
1131
#	Line 760 | Line 1157 | end;
1157
1158		constructor TIBCustomDataSet.Create(AOwner: TComponent);
1159		begin
1160	<	inherited;
1160	>	inherited Create(AOwner);
1161		FIBLoaded := False;
1162		CheckIBLoaded;
1163		FIBLoaded := True;
1164		FBase := TIBBase.Create(Self);
1165	+	FIBLinks := TList.Create;
1166		FCurrentRecord := -1;
1167		FDeletedRecords := 0;
1168		FUniDirectional := False;
1169		FBufferChunks := BufferCacheSize;
1170		FBlobStreamList := TList.Create;
1171	+	FGeneratorField := TIBGenerator.Create(self);
1172		FDataLink := TIBDataLink.Create(Self);
1173		FQDelete := TIBSQL.Create(Self);
1174		FQDelete.OnSQLChanging := SQLChanging;
#	Line 782 | Line 1181 | begin
1181		FQRefresh.GoToFirstRecordOnExecute := False;
1182		FQSelect := TIBSQL.Create(Self);
1183		FQSelect.OnSQLChanging := SQLChanging;
1184	+	FQSelect.OnSQLChanged := SQLChanged;
1185		FQSelect.GoToFirstRecordOnExecute := False;
1186		FQModify := TIBSQL.Create(Self);
1187		FQModify.OnSQLChanging := SQLChanging;
1188		FQModify.GoToFirstRecordOnExecute := False;
1189		FUpdateRecordTypes := [cusUnmodified, cusModified, cusInserted];
1190		FParamCheck := True;
1191	+	FGenerateParamNames := False;
1192		FForcedRefresh := False;
1193	+	FAutoCommit:= acDisabled;
1194	+	FDataSetCloseAction := dcDiscardChanges;
1195		{Bookmark Size is Integer for IBX}
1196		BookmarkSize := SizeOf(Integer);
1197		FBase.BeforeDatabaseDisconnect := DoBeforeDatabaseDisconnect;
#	Line 802 | Line 1205 | begin
1205		else
1206		if AOwner is TIBTransaction then
1207		Transaction := TIBTransaction(AOwner);
1208	+	FBaseSQLSelect := TStringList.Create;
1209		end;
1210
1211		destructor TIBCustomDataSet.Destroy;
1212		begin
1213	<	inherited;
1213	>	if Active then Active := false;
1214		if FIBLoaded then
1215		begin
1216	+	if assigned(FGeneratorField) then FGeneratorField.Free;
1217		FDataLink.Free;
1218		FBase.Free;
1219		ClearBlobCache;
1220	+	ClearIBLinks;
1221	+	FIBLinks.Free;
1222		FBlobStreamList.Free;
1223		FreeMem(FBufferCache);
1224		FBufferCache := nil;
#	Line 821 | Line 1228 | begin
1228		FOldCacheSize := 0;
1229		FMappedFieldPosition := nil;
1230		end;
1231	+	if assigned(FBaseSQLSelect) then FBaseSQLSelect.Free;
1232	+	if assigned(FParser) then FParser.Free;
1233	+	inherited Destroy;
1234		end;
1235
1236		function TIBCustomDataSet.AdjustCurrentRecord(Buffer: Pointer; GetMode: TGetMode):
#	Line 861 | Line 1271 | end;
1271
1272		procedure TIBCustomDataSet.ApplyUpdates;
1273		var
1274	+	{$IFDEF NEW_TBOOKMARK }
1275	+	CurBookmark: TBookmark;
1276	+	{$ELSE}
1277		CurBookmark: string;
1278	+	{$ENDIF}
1279		Buffer: PRecordData;
1280		CurUpdateTypes: TIBUpdateRecordTypes;
1281		UpdateAction: TIBUpdateAction;
#	Line 921 | Line 1335 | var
1335		procedure UpdateUsingUpdateObject;
1336		begin
1337		try
1338	<	FUpdateObject.Apply(UpdateKind);
1338	>	FUpdateObject.Apply(UpdateKind,PChar(Buffer));
1339		ResetBufferUpdateStatus;
1340		except
1341		on E: Exception do
#	Line 1059 | Line 1473 | begin
1473		end;
1474		end;
1475
1476	+	function TIBCustomDataSet.GetFieldPosition(AliasName: string): integer;
1477	+	var i: integer;
1478	+	Prepared: boolean;
1479	+	begin
1480	+	Result := 0;
1481	+	Prepared := FInternalPrepared;
1482	+	if not Prepared then
1483	+	InternalPrepare;
1484	+	try
1485	+	for i := 0 to Length(FAliasNameList) - 1 do
1486	+	if FAliasNameList[i] = AliasName then
1487	+	begin
1488	+	Result := i + 1;
1489	+	Exit
1490	+	end;
1491	+	finally
1492	+	if not Prepared then
1493	+	InternalUnPrepare;
1494	+	end;
1495	+	end;
1496	+
1497		procedure TIBCustomDataSet.ActivateConnection;
1498		begin
1499		if not Assigned(Database) then
#	Line 1119 | Line 1554 | begin
1554		IBError(ibxeDatasetClosed, [nil]);
1555		end;
1556
1557	+	function TIBCustomDataSet.CreateParser: TSelectSQLParser;
1558	+	begin
1559	+	Result := TSelectSQLParser.Create(self,FBaseSQLSelect);
1560	+	Result.OnSQLChanging := SQLChanging
1561	+	end;
1562	+
1563		procedure TIBCustomDataSet.CheckNotUniDirectional;
1564		begin
1565		if UniDirectional then
#	Line 1222 | Line 1663 | begin
1663		FDatabaseFree(Sender);
1664		end;
1665
1666	<	procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject);
1666	>	procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject;
1667	>	Action: TTransactionAction);
1668		begin
1669	<	if Active then
1670	<	Active := False;
1669	>	FCloseAction := Action;
1670	>	FInTransactionEnd := true;
1671	>	try
1672	>	if Active then
1673	>	Active := False;
1674	>	finally
1675	>	FInTransactionEnd := false;
1676	>	end;
1677		if FQSelect <> nil then
1678		FQSelect.FreeHandle;
1679		if FQDelete <> nil then
#	Line 1263 | Line 1711 | var
1711		LocalData: Pointer;
1712		LocalDate, LocalDouble: Double;
1713		LocalInt: Integer;
1714	+	LocalBool: wordBool;
1715		LocalInt64: Int64;
1716		LocalCurrency: Currency;
1717		FieldsLoaded: Integer;
#	Line 1314 | Line 1763 | begin
1763		(Qry.Current[i].Data^.sqltype and 1 = 1);
1764		rdFields[j].fdIsNull :=
1765		(rdFields[j].fdNullable and (Qry.Current[i].Data^.sqlind^ = -1));
1766	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1767	+	rdFields[j].fdCodePage := 0;
1768	+	{$ENDIF}
1769		LocalData := Qry.Current[i].Data^.sqldata;
1770		case rdFields[j].fdDataType of
1771		SQL_TIMESTAMP:
#	Line 1394 | Line 1846 | begin
1846		begin
1847		rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
1848		rdFields[j].fdDataLength := isc_vax_integer(Qry.Current[i].Data^.sqldata, 2);
1849	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1850	+	TFirebirdCharacterSets.CharSetID2CodePage(Qry.Current[i].Data^.sqlsubtype and $FF,
1851	+	rdFields[j].fdCodePage);
1852	+	{$ENDIF}
1853		if RecordNumber >= 0 then
1854		begin
1855		if (rdFields[j].fdDataLength = 0) then
1856		LocalData := nil
1857		else
1858	<	LocalData := @Qry.Current[i].Data^.sqldata[2];
1858	>	Inc(LocalData,2);
1859		end;
1860		end;
1861	<	else { SQL_TEXT, SQL_BLOB, SQL_ARRAY, SQL_QUAD }
1861	>	SQL_BOOLEAN:
1862	>	begin
1863	>	LocalBool:= false;
1864	>	rdFields[j].fdDataSize := SizeOf(wordBool);
1865	>	if RecordNumber >= 0 then
1866	>	LocalBool := Qry.Current[i].AsBoolean;
1867	>	LocalData := PChar(@LocalBool);
1868	>	end;
1869	>	SQL_TEXT:
1870	>	begin
1871	>	rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
1872	>	rdFields[j].fdDataLength := rdFields[j].fdDataSize;
1873	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1874	>	TFirebirdCharacterSets.CharSetID2CodePage(Qry.Current[i].Data^.sqlsubtype and $FF,
1875	>	rdFields[j].fdCodePage);
1876	>	{$ENDIF}
1877	>	end;
1878	>	else {  SQL_BLOB, SQL_ARRAY, SQL_QUAD }
1879		begin
1880		rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
1408	–	if (rdFields[j].fdDataType = SQL_TEXT) then
1409	–	rdFields[j].fdDataLength := rdFields[j].fdDataSize;
1881		end;
1882		end;
1883		if RecordNumber < 0 then
#	Line 1526 | Line 1997 | end;
1997		procedure TIBCustomDataSet.InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer);
1998		begin
1999		if (Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukDelete).Text <> '')) then
2000	<	FUpdateObject.Apply(ukDelete)
2000	>	FUpdateObject.Apply(ukDelete,Buff)
2001		else
2002		begin
2003		SetInternalSQLParams(FQDelete, Buff);
#	Line 1543 | Line 2014 | end;
2014		function TIBCustomDataSet.InternalLocate(const KeyFields: string;
2015		const KeyValues: Variant; Options: TLocateOptions): Boolean;
2016		var
2017	<	fl: TList;
2017	>	keyFieldList: TList;
2018	>	{$IFDEF NEW_TBOOKMARK }
2019	>	CurBookmark: TBookmark;
2020	>	{$ELSE}
2021		CurBookmark: string;
2022	<	fld, val: Variant;
2023	<	i, fld_cnt: Integer;
2022	>	{$ENDIF}
2023	>	fieldValue: Variant;
2024	>	lookupValues: array of variant;
2025	>	i, fieldCount: Integer;
2026	>	fieldValueAsString: string;
2027	>	lookupValueAsString: string;
2028		begin
2029	<	fl := TList.Create;
2029	>	keyFieldList := TList.Create;
2030		try
2031	<	GetFieldList(fl, KeyFields);
2032	<	fld_cnt := fl.Count;
2031	>	GetFieldList(keyFieldList, KeyFields);
2032	>	fieldCount := keyFieldList.Count;
2033		CurBookmark := Bookmark;
2034	<	result := False;
2035	<	while ((not result) and (not EOF)) do
2034	>	result := false;
2035	>	SetLength(lookupValues, fieldCount);
2036	>	if not EOF then
2037		begin
2038	<	i := 0;
1560	<	result := True;
1561	<	while (result and (i < fld_cnt)) do
2038	>	for i := 0 to fieldCount - 1 do  {expand key values into lookupValues array}
2039		begin
2040	<	if fld_cnt > 1 then
2041	<	val := KeyValues[i]
2040	>	if VarIsArray(KeyValues) then
2041	>	lookupValues[i] := KeyValues[i]
2042	>	else
2043	>	if i > 0 then
2044	>	lookupValues[i] := NULL
2045		else
2046	<	val := KeyValues;
2047	<	fld := TField(fl[i]).Value;
2048	<	result := not (VarIsNull(val) xor VarIsNull(fld));
2049	<	if result and not VarIsNull(val) then
2046	>	lookupValues[0] := KeyValues;
2047	>
2048	>	{convert to upper case is case insensitive search}
2049	>	if (TField(keyFieldList[i]).DataType = ftString) and
2050	>	not VarIsNull(lookupValues[i]) and (loCaseInsensitive in Options) then
2051	>	lookupValues[i] := UpperCase(lookupValues[i]);
2052	>	end;
2053	>	end;
2054	>	while not result and not EOF do   {search for a matching record}
2055	>	begin
2056	>	i := 0;
2057	>	result := true;
2058	>	while result and (i < fieldCount) do
2059	>	{see if all of the key fields matches}
2060	>	begin
2061	>	fieldValue := TField(keyFieldList[i]).Value;
2062	>	result := not (VarIsNull(fieldValue) xor VarIsNull(lookupValues[i]));
2063	>	if result and not VarIsNull(fieldValue) then
2064		begin
2065		try
2066	<	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
2066	>	if TField(keyFieldList[i]).DataType = ftString then
2067		begin
2068	+	{strings need special handling because of the locate options that
2069	+	apply to them}
2070	+	fieldValueAsString := TField(keyFieldList[i]).AsString;
2071	+	lookupValueAsString := lookupValues[i];
2072		if (loCaseInsensitive in Options) then
2073	<	begin
2074	<	fld := AnsiUpperCase(fld);
1582	<	val := AnsiUpperCase(val);
1583	<	end;
1584	<	fld := TrimRight(fld);
1585	<	val := TrimRight(val);
2073	>	fieldValueAsString := UpperCase(fieldValueAsString);
2074	>
2075		if (loPartialKey in Options) then
2076	<	result := result and (AnsiPos(val, fld) = 1)
2076	>	result := result and (Pos(lookupValueAsString, fieldValueAsString) = 1)
2077		else
2078	<	result := result and (val = fld);
2079	<	end else
2080	<	result := result and (val = fld);
2078	>	result := result and (fieldValueAsString = lookupValueAsString);
2079	>	end
2080	>	else
2081	>	result := result and (lookupValues[i] =
2082	>	VarAsType(fieldValue, VarType(lookupValues[i])));
2083	>	except on EVariantError do
2084	>	result := False;
2085	>	end;
2086		end;
2087		Inc(i);
2088		end;
2089		if not result then
2090	<	Next;
2090	>	Next;
2091		end;
2092		if not result then
2093		Bookmark := CurBookmark
2094		else
2095		CursorPosChanged;
2096		finally
2097	<	fl.Free;
2097	>	keyFieldList.Free;
2098	>	SetLength(lookupValues,0)
2099		end;
2100		end;
2101
#	Line 1628 | Line 2123 | begin
2123		if Assigned(FUpdateObject) then
2124		begin
2125		if (Qry = FQDelete) then
2126	<	FUpdateObject.Apply(ukDelete)
2126	>	FUpdateObject.Apply(ukDelete,Buff)
2127		else if (Qry = FQInsert) then
2128	<	FUpdateObject.Apply(ukInsert)
2128	>	FUpdateObject.Apply(ukInsert,Buff)
2129		else
2130	<	FUpdateObject.Apply(ukModify);
2130	>	FUpdateObject.Apply(ukModify,Buff);
2131		end
2132		else begin
2133		SetInternalSQLParams(Qry, Buff);
#	Line 1649 | Line 2144 | end;
2144		procedure TIBCustomDataSet.InternalRefreshRow;
2145		var
2146		Buff: PChar;
1652	–	SetCursor: Boolean;
2147		ofs: DWORD;
2148		Qry: TIBSQL;
2149		begin
2150	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1657	<	if SetCursor then
1658	<	Screen.Cursor := crHourGlass;
2150	>	FBase.SetCursor;
2151		try
2152		Buff := GetActiveBuf;
2153		if CanRefresh then
#	Line 1699 | Line 2191 | begin
2191		else
2192		IBError(ibxeCannotRefresh, [nil]);
2193		finally
2194	<	if SetCursor and (Screen.Cursor = crHourGlass) then
1703	<	Screen.Cursor := crDefault;
2194	>	FBase.RestoreCursor;
2195		end;
2196		end;
2197
#	Line 1771 | Line 2262 | end;
2262
2263		procedure TIBCustomDataSet.InternalPrepare;
2264		var
1774	–	SetCursor: Boolean;
2265		DidActivate: Boolean;
2266		begin
2267		if FInternalPrepared then
2268		Exit;
2269		DidActivate := False;
2270	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1781	<	if SetCursor then
1782	<	Screen.Cursor := crHourGlass;
2270	>	FBase.SetCursor;
2271		try
2272		ActivateConnection;
2273		DidActivate := ActivateTransaction;
2274		FBase.CheckDatabase;
2275		FBase.CheckTransaction;
2276	+	if HasParser and (FParser.SQLText <> FQSelect.SQL.Text) then
2277	+	begin
2278	+	FQSelect.OnSQLChanged := nil; {Do not react to change}
2279	+	try
2280	+	FQSelect.SQL.Text := FParser.SQLText;
2281	+	finally
2282	+	FQSelect.OnSQLChanged := SQLChanged;
2283	+	end;
2284	+	end;
2285	+	//   writeln( FQSelect.SQL.Text);
2286		if FQSelect.SQL.Text <> '' then
2287		begin
2288		if not FQSelect.Prepared then
2289		begin
2290	+	FQSelect.GenerateParamNames := FGenerateParamNames;
2291		FQSelect.ParamCheck := ParamCheck;
2292		FQSelect.Prepare;
2293		end;
2294	<	if (FQDelete.SQL.Text <> '') and (not FQDelete.Prepared) then
2294	>	FQDelete.GenerateParamNames := FGenerateParamNames;
2295	>	if (Trim(FQDelete.SQL.Text) <> '') and (not FQDelete.Prepared) then
2296		FQDelete.Prepare;
2297	<	if (FQInsert.SQL.Text <> '') and (not FQInsert.Prepared) then
2297	>	FQInsert.GenerateParamNames := FGenerateParamNames;
2298	>	if (Trim(FQInsert.SQL.Text) <> '') and (not FQInsert.Prepared) then
2299		FQInsert.Prepare;
2300	<	if (FQRefresh.SQL.Text <> '') and (not FQRefresh.Prepared) then
2300	>	FQRefresh.GenerateParamNames := FGenerateParamNames;
2301	>	if (Trim(FQRefresh.SQL.Text) <> '') and (not FQRefresh.Prepared) then
2302		FQRefresh.Prepare;
2303	<	if (FQModify.SQL.Text <> '') and (not FQModify.Prepared) then
2303	>	FQModify.GenerateParamNames := FGenerateParamNames;
2304	>	if (Trim(FQModify.SQL.Text) <> '') and (not FQModify.Prepared) then
2305		FQModify.Prepare;
2306		FInternalPrepared := True;
2307		InternalInitFieldDefs;
#	Line 1807 | Line 2310 | begin
2310		finally
2311		if DidActivate then
2312		DeactivateTransaction;
2313	<	if SetCursor and (Screen.Cursor = crHourGlass) then
1811	<	Screen.Cursor := crDefault;
2313	>	FBase.RestoreCursor;
2314		end;
2315		end;
2316
#	Line 1910 | Line 2412 | procedure TIBCustomDataSet.SetInternalSQ
2412		var
2413		i, j: Integer;
2414		cr, data: PChar;
2415	<	fn, st: string;
2415	>	fn: string;
2416	>	st: RawByteString;
2417		OldBuffer: Pointer;
2418		ts: TTimeStamp;
2419		begin
#	Line 1958 | Line 2461 | begin
2461		SQL_TEXT, SQL_VARYING:
2462		begin
2463		SetString(st, data, rdFields[j].fdDataLength);
2464	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
2465	+	SetCodePage(st,rdFields[j].fdCodePage,false);
2466	+	{$ENDIF}
2467		Qry.Params[i].AsString := st;
2468		end;
2469		SQL_FLOAT, SQL_DOUBLE, SQL_D_FLOAT:
#	Line 1998 | Line 2504 | begin
2504		end;
2505		SQL_TIMESTAMP:
2506		Qry.Params[i].AsDateTime :=
2507	<	TimeStampToDateTime(
2508	<	MSecsToTimeStamp(PDouble(data)^));
2507	>	TimeStampToDateTime(MSecsToTimeStamp(trunc(PDouble(data)^)));
2508	>	SQL_BOOLEAN:
2509	>	Qry.Params[i].AsBoolean := PWordBool(data)^;
2510		end;
2511		end;
2512		end;
#	Line 2085 | Line 2592 | begin
2592		end;
2593		end;
2594
2595	+	procedure TIBCustomDataSet.RegisterIBLink(Sender: TIBControlLink);
2596	+	begin
2597	+	if FIBLinks.IndexOf(Sender) = -1 then
2598	+	FIBLinks.Add(Sender);
2599	+	end;
2600	+
2601
2602		procedure TIBCustomDataSet.SQLChanging(Sender: TObject);
2603		begin
2604	<	if FOpen then
2605	<	InternalClose;
2604	>	Active := false;
2605	>	{  if FOpen then
2606	>	InternalClose;}
2607		if FInternalPrepared then
2608		InternalUnPrepare;
2609	+	FieldDefs.Clear;
2610	+	FieldDefs.Updated := false;
2611	+	end;
2612	+
2613	+	procedure TIBCustomDataSet.SQLChanged(Sender: TObject);
2614	+	begin
2615	+	FBaseSQLSelect.assign(FQSelect.SQL);
2616		end;
2617
2618		{ I can "undelete" uninserted records (make them "inserted" again).
#	Line 2120 | Line 2641 | begin
2641		end;
2642		end;
2643
2644	+	procedure TIBCustomDataSet.UnRegisterIBLink(Sender: TIBControlLink);
2645	+	begin
2646	+	FIBLinks.Remove(Sender);
2647	+	end;
2648	+
2649		function TIBCustomDataSet.UpdateStatus: TUpdateStatus;
2650		begin
2651		if Active then
#	Line 2136 | Line 2662 | begin
2662		Result := Assigned( FQSelect ) and FQSelect.EOF;
2663		end;
2664
2665	+	function TIBCustomDataSet.ParamByName(ParamName: String): TIBXSQLVAR;
2666	+	begin
2667	+	ActivateConnection;
2668	+	ActivateTransaction;
2669	+	if not FInternalPrepared then
2670	+	InternalPrepare;
2671	+	Result := Params.ByName(ParamName);
2672	+	end;
2673	+
2674	+	{Beware: the parameter FCache is used as an identifier to determine which
2675	+	cache is being operated on and is not referenced in the computation.
2676	+	The result is an adjusted offset into the identified cache, either the
2677	+	Buffer Cache or the old Buffer Cache.}
2678	+
2679		function TIBCustomDataSet.AdjustPosition(FCache: PChar; Offset: DWORD;
2680	<	Origin: Integer): Integer;
2680	>	Origin: Integer): DWORD;
2681		var
2682		OldCacheSize: Integer;
2683		begin
#	Line 2174 | Line 2714 | procedure TIBCustomDataSet.ReadCache(FCa
2714		Buffer: PChar);
2715		var
2716		pCache: PChar;
2717	+	AdjustedOffset: DWORD;
2718		bOld: Boolean;
2719		begin
2720		bOld := (FCache = FOldBufferCache);
2721	<	pCache := PChar(AdjustPosition(FCache, Offset, Origin));
2721	>	AdjustedOffset := AdjustPosition(FCache, Offset, Origin);
2722		if not bOld then
2723	<	pCache := FBufferCache + Integer(pCache)
2723	>	pCache := FBufferCache + AdjustedOffset
2724		else
2725	<	pCache := FOldBufferCache + Integer(pCache);
2725	>	pCache := FOldBufferCache + AdjustedOffset;
2726		Move(pCache^, Buffer^, DWORD(FRecordBufferSize));
2727		AdjustPosition(FCache, FRecordBufferSize, FILE_CURRENT);
2728		end;
#	Line 2211 | Line 2752 | procedure TIBCustomDataSet.WriteCache(FC
2752		Buffer: PChar);
2753		var
2754		pCache: PChar;
2755	+	AdjustedOffset: DWORD;
2756		bOld: Boolean;
2757		dwEnd: DWORD;
2758		begin
2759		bOld := (FCache = FOldBufferCache);
2760	<	pCache := PChar(AdjustPosition(FCache, Offset, Origin));
2760	>	AdjustedOffset := AdjustPosition(FCache, Offset, Origin);
2761		if not bOld then
2762	<	pCache := FBufferCache + Integer(pCache)
2762	>	pCache := FBufferCache + AdjustedOffset
2763		else
2764	<	pCache := FOldBufferCache + Integer(pCache);
2764	>	pCache := FOldBufferCache + AdjustedOffset;
2765		Move(Buffer^, pCache^, FRecordBufferSize);
2766		dwEnd := AdjustPosition(FCache, FRecordBufferSize, FILE_CURRENT);
2767		if not bOld then
#	Line 2330 | Line 2872 | begin
2872		if FCachedUpdates and
2873		(Buff^.rdCachedUpdateStatus in [cusUnmodified]) then
2874		SaveOldBuffer(PChar(Buff));
2875	<	inherited;
2875	>	inherited DoBeforeDelete;
2876	>	end;
2877	>
2878	>	procedure TIBCustomDataSet.DoAfterDelete;
2879	>	begin
2880	>	inherited DoAfterDelete;
2881	>	FBase.DoAfterDelete(self);
2882	>	InternalAutoCommit;
2883		end;
2884
2885		procedure TIBCustomDataSet.DoBeforeEdit;
#	Line 2344 | Line 2893 | begin
2893		if FCachedUpdates and (Buff^.rdCachedUpdateStatus in [cusUnmodified, cusInserted]) then
2894		SaveOldBuffer(PChar(Buff));
2895		CopyRecordBuffer(GetActiveBuf, FOldBuffer);
2896	<	inherited;
2896	>	inherited DoBeforeEdit;
2897	>	end;
2898	>
2899	>	procedure TIBCustomDataSet.DoAfterEdit;
2900	>	begin
2901	>	inherited DoAfterEdit;
2902	>	FBase.DoAfterEdit(self);
2903		end;
2904
2905		procedure TIBCustomDataSet.DoBeforeInsert;
2906		begin
2907		if not CanInsert then
2908		IBError(ibxeCannotInsert, [nil]);
2909	<	inherited;
2909	>	inherited DoBeforeInsert;
2910	>	end;
2911	>
2912	>	procedure TIBCustomDataSet.DoAfterInsert;
2913	>	begin
2914	>	if GeneratorField.ApplyOnEvent = gaeOnNewRecord then
2915	>	GeneratorField.Apply;
2916	>	inherited DoAfterInsert;
2917	>	FBase.DoAfterInsert(self);
2918	>	end;
2919	>
2920	>	procedure TIBCustomDataSet.DoBeforeClose;
2921	>	begin
2922	>	inherited DoBeforeClose;
2923	>	if State in [dsInsert,dsEdit] then
2924	>	begin
2925	>	if FInTransactionEnd and (FCloseAction = TARollback) then
2926	>	Exit;
2927	>
2928	>	if DataSetCloseAction = dcSaveChanges then
2929	>	Post;
2930	>	{Note this can fail with an exception e.g. due to
2931	>	database validation error. In which case the dataset remains open }
2932	>	end;
2933	>	end;
2934	>
2935	>	procedure TIBCustomDataSet.DoBeforeOpen;
2936	>	var i: integer;
2937	>	begin
2938	>	if assigned(FParser) then
2939	>	FParser.Reset;
2940	>	for i := 0 to FIBLinks.Count - 1 do
2941	>	TIBControlLink(FIBLinks[i]).UpdateSQL(self);
2942	>	inherited DoBeforeOpen;
2943	>	for i := 0 to FIBLinks.Count - 1 do
2944	>	TIBControlLink(FIBLinks[i]).UpdateParams(self);
2945	>	end;
2946	>
2947	>	procedure TIBCustomDataSet.DoBeforePost;
2948	>	begin
2949	>	inherited DoBeforePost;
2950	>	if (State = dsInsert) and
2951	>	(GeneratorField.ApplyOnEvent = gaeOnPostRecord) then
2952	>	GeneratorField.Apply
2953	>	end;
2954	>
2955	>	procedure TIBCustomDataSet.DoAfterPost;
2956	>	begin
2957	>	inherited DoAfterPost;
2958	>	FBase.DoAfterPost(self);
2959	>	InternalAutoCommit;
2960		end;
2961
2962		procedure TIBCustomDataSet.FetchAll;
2963		var
2964	<	SetCursor: Boolean;
2964	>	{$IFDEF NEW_TBOOKMARK }
2965	>	CurBookmark: TBookmark;
2966	>	{$ELSE}
2967		CurBookmark: string;
2968	+	{$ENDIF}
2969		begin
2970	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
2971	<	if SetCursor then
2364	<	Screen.Cursor := crHourGlass;
2365	<	try
2970	>	FBase.SetCursor;
2971	>	try
2972		if FQSelect.EOF or not FQSelect.Open then
2973		exit;
2974		DisableControls;
#	Line 2374 | Line 2980 | begin
2980		EnableControls;
2981		end;
2982		finally
2983	<	if SetCursor and (Screen.Cursor = crHourGlass) then
2378	<	Screen.Cursor := crDefault;
2983	>	FBase.RestoreCursor;
2984		end;
2985		end;
2986
#	Line 2423 | Line 3028 | begin
3028		result := FDataLink.DataSource;
3029		end;
3030
3031	+	function TIBCustomDataSet.GetDBAliasName(FieldNo: integer): string;
3032	+	begin
3033	+	Result := FAliasNameMap[FieldNo-1]
3034	+	end;
3035	+
3036	+	function TIBCustomDataSet.GetFieldDefFromAlias(aliasName: string): TFieldDef;
3037	+	var
3038	+	i: integer;
3039	+	begin
3040	+	Result := nil;
3041	+	for i := 0 to Length(FAliasNameMap) - 1 do
3042	+	if FAliasNameMap[i] = aliasName then
3043	+	begin
3044	+	Result := FieldDefs[i];
3045	+	Exit
3046	+	end;
3047	+	end;
3048	+
3049		function TIBCustomDataSet.GetFieldClass(FieldType: TFieldType): TFieldClass;
3050		begin
3051		Result := DefaultFieldClasses[FieldType];
#	Line 2441 | Line 3064 | begin
3064		result := False;
3065		Buff := GetActiveBuf;
3066		if (Buff = nil) or
3067	<	(not IsVisible(Buff)) then
3067	>	(not IsVisible(Buff)) or not assigned(Field.DataSet) then
3068		exit;
3069		{ The intention here is to stuff the buffer with the data for the
3070		referenced field for the current record }
#	Line 2463 | Line 3086 | begin
3086		Data := Buff + CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs;
3087		if (fdDataType = SQL_VARYING) or (fdDataType = SQL_TEXT) then
3088		begin
3089	<	Move(Data^, Buffer^, fdDataLength);
3090	<	PChar(Buffer)[fdDataLength] := #0;
3089	>	if fdDataLength < Field.DataSize then
3090	>	begin
3091	>	Move(Data^, Buffer^, fdDataLength);
3092	>	PChar(Buffer)[fdDataLength] := #0;
3093	>	end
3094	>	else
3095	>	IBError(ibxeFieldSizeError,[Field.FieldName])
3096		end
3097		else
3098		Move(Data^, Buffer^, Field.DataSize);
#	Line 2507 | Line 3135 | begin
3135		if not Accept and (GetMode = gmCurrent) then
3136		GetMode := gmPrior;
3137		except
3138	<	//        Application.HandleException(Self);
3138	>	//        FBase.HandleException(Self);
3139		end;
3140		end;
3141		RestoreState(SaveState);
#	Line 2601 | Line 3229 | begin
3229		result := FRecordBufferSize;
3230		end;
3231
3232	+	procedure TIBCustomDataSet.InternalAutoCommit;
3233	+	begin
3234	+	with Transaction do
3235	+	if InTransaction and (FAutoCommit = acCommitRetaining) then
3236	+	begin
3237	+	if CachedUpdates then ApplyUpdates;
3238	+	CommitRetaining;
3239	+	end;
3240	+	end;
3241	+
3242		procedure TIBCustomDataSet.InternalAddRecord(Buffer: Pointer; Append: Boolean);
3243		begin
3244		CheckEditState;
#	Line 2629 | Line 3267 | var
3267		Buff: PChar;
3268		CurRec: Integer;
3269		begin
3270	<	inherited;
3270	>	inherited InternalCancel;
3271		Buff := GetActiveBuf;
3272		if Buff <> nil then begin
3273		CurRec := FCurrentRecord;
#	Line 2672 | Line 3310 | begin
3310		FreeMem(FOldBufferCache);
3311		FOldBufferCache := nil;
3312		BindFields(False);
3313	+	ResetParser;
3314		if DefaultFields then DestroyFields;
3315		end;
3316
3317		procedure TIBCustomDataSet.InternalDelete;
3318		var
3319		Buff: PChar;
2681	–	SetCursor: Boolean;
3320		begin
3321	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
2684	<	if SetCursor then
2685	<	Screen.Cursor := crHourGlass;
3321	>	FBase.SetCursor;
3322		try
3323		Buff := GetActiveBuf;
3324		if CanDelete then
#	Line 2707 | Line 3343 | begin
3343		end else
3344		IBError(ibxeCannotDelete, [nil]);
3345		finally
3346	<	if SetCursor and (Screen.Cursor = crHourGlass) then
2711	<	Screen.Cursor := crDefault;
3346	>	FBase.RestoreCursor;
3347		end;
3348		end;
3349
#	Line 2724 | Line 3359 | end;
3359
3360		procedure TIBCustomDataSet.InternalHandleException;
3361		begin
3362	<	Application.HandleException(Self)
3362	>	FBase.HandleException(Self)
3363		end;
3364
3365		procedure TIBCustomDataSet.InternalInitFieldDefs;
3366	+	begin
3367	+	if not InternalPrepared then
3368	+	begin
3369	+	InternalPrepare;
3370	+	exit;
3371	+	end;
3372	+	FieldDefsFromQuery(FQSelect);
3373	+	end;
3374	+
3375	+	procedure TIBCustomDataSet.FieldDefsFromQuery(SourceQuery: TIBSQL);
3376		const
3377		DefaultSQL = 'Select F.RDB$COMPUTED_BLR, ' + {do not localize}
3378		'F.RDB$DEFAULT_VALUE, R.RDB$FIELD_NAME ' + {do not localize}
#	Line 2739 | Line 3384 | const
3384		var
3385		FieldType: TFieldType;
3386		FieldSize: Word;
3387	+	charSetID: integer;
3388	+	CharSetSize: integer;
3389	+	CharSetName: RawByteString;
3390	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3391	+	FieldCodePage: TSystemCodePage;
3392	+	{$ENDIF}
3393		FieldNullable : Boolean;
3394		i, FieldPosition, FieldPrecision: Integer;
3395	<	FieldAliasName: string;
3395	>	FieldAliasName, DBAliasName: string;
3396		RelationName, FieldName: string;
3397		Query : TIBSQL;
3398		FieldIndex: Integer;
#	Line 2841 | Line 3492 | var
3492		end;
3493
3494		begin
2844	–	if not InternalPrepared then
2845	–	begin
2846	–	InternalPrepare;
2847	–	exit;
2848	–	end;
3495		FRelationNodes := TRelationNode.Create;
3496		FNeedsRefresh := False;
3497		Database.InternalTransaction.StartTransaction;
#	Line 2856 | Line 3502 | begin
3502		FieldDefs.BeginUpdate;
3503		FieldDefs.Clear;
3504		FieldIndex := 0;
3505	<	if (Length(FMappedFieldPosition) < FQSelect.Current.Count) then
3506	<	SetLength(FMappedFieldPosition, FQSelect.Current.Count);
3505	>	if (Length(FMappedFieldPosition) < SourceQuery.Current.Count) then
3506	>	SetLength(FMappedFieldPosition, SourceQuery.Current.Count);
3507		Query.SQL.Text := DefaultSQL;
3508		Query.Prepare;
3509	<	for i := 0 to FQSelect.Current.Count - 1 do
3510	<	with FQSelect.Current[i].Data^ do
3509	>	SetLength(FAliasNameMap, SourceQuery.Current.Count);
3510	>	SetLength(FAliasNameList, SourceQuery.Current.Count);
3511	>	for i := 0 to SourceQuery.Current.Count - 1 do
3512	>	with SourceQuery.Current[i].Data^ do
3513		begin
3514		{ Get the field name }
3515	<	SetString(FieldAliasName, aliasname, aliasname_length);
3515	>	FieldAliasName := SourceQuery.Current[i].Name;
3516	>	SetString(DBAliasName, aliasname, aliasname_length);
3517		SetString(RelationName, relname, relname_length);
3518		SetString(FieldName, sqlname, sqlname_length);
3519	+	FAliasNameList[i] := DBAliasName;
3520		FieldSize := 0;
3521		FieldPrecision := 0;
3522	<	FieldNullable := FQSelect.Current[i].IsNullable;
3522	>	FieldNullable := SourceQuery.Current[i].IsNullable;
3523	>	CharSetSize := 0;
3524	>	CharSetName := '';
3525	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3526	>	FieldCodePage := CP_NONE;
3527	>	{$ENDIF}
3528		case sqltype and not 1 of
3529		{ All VARCHAR's must be converted to strings before recording
3530		their values }
3531		SQL_VARYING, SQL_TEXT:
3532		begin
3533	+	CharSetID := SourceQuery.Current[i].GetCharSetID;
3534	+	TFirebirdCharacterSets.CharSetWidth(CharSetID,CharSetSize);
3535	+	CharSetName := TFirebirdCharacterSets.GetCharsetName(CharSetID);
3536	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3537	+	TFirebirdCharacterSets.CharSetID2CodePage(CharSetID,FieldCodePage);
3538	+	{$ENDIF}
3539		FieldSize := sqllen;
3540		FieldType := ftString;
3541		end;
#	Line 2902 | Line 3563 | begin
3563		FieldSize := -sqlscale;
3564		end
3565		else
3566	<	FieldType := ftFloat;
3566	>	if Database.SQLDialect = 1 then
3567	>	FieldType := ftFloat
3568	>	else
3569	>	if (FieldCount > i) and (Fields[i] is TFloatField) then
3570	>	FieldType := ftFloat
3571	>	else
3572	>	begin
3573	>	FieldType := ftFMTBCD;
3574	>	FieldPrecision := 9;
3575	>	FieldSize := -sqlscale;
3576		end;
3577	+	end;
3578	+
3579		SQL_INT64:
3580		begin
3581		if (sqlscale = 0) then
#	Line 2915 | Line 3587 | begin
3587		FieldSize := -sqlscale;
3588		end
3589		else
3590	<	FieldType := ftFloat;
3591	<	end;
3590	>	FieldType := ftFloat
3591	>	end;
3592		SQL_TIMESTAMP: FieldType := ftDateTime;
3593		SQL_TYPE_TIME: FieldType := ftTime;
3594		SQL_TYPE_DATE: FieldType := ftDate;
#	Line 2924 | Line 3596 | begin
3596		begin
3597		FieldSize := sizeof (TISC_QUAD);
3598		if (sqlsubtype = 1) then
3599	<	FieldType := ftmemo
3599	>	begin
3600	>	CharSetID := SourceQuery.Current[i].GetCharSetID;
3601	>	TFirebirdCharacterSets.CharSetWidth(CharSetID,CharSetSize);
3602	>	CharSetName := TFirebirdCharacterSets.GetCharsetName(CharSetID);
3603	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3604	>	TFirebirdCharacterSets.CharSetID2CodePage(CharSetID,FieldCodePage);
3605	>	{$ENDIF}
3606	>	FieldType := ftMemo;
3607	>	end
3608		else
3609		FieldType := ftBlob;
3610		end;
#	Line 2933 | Line 3613 | begin
3613		FieldSize := sizeof (TISC_QUAD);
3614		FieldType := ftUnknown;
3615		end;
3616	+	SQL_BOOLEAN:
3617	+	FieldType:= ftBoolean;
3618		else
3619		FieldType := ftUnknown;
3620		end;
#	Line 2941 | Line 3623 | begin
3623		begin
3624		FMappedFieldPosition[FieldIndex] := FieldPosition;
3625		Inc(FieldIndex);
3626	<	with FieldDefs.AddFieldDef do
3626	>	with TIBFieldDef.Create(FieldDefs,'',FieldType,0,False,FieldDefs.Count+1) do
3627		begin
3628	<	Name := string( FieldAliasName );
3629	<	FieldNo := FieldPosition;
2948	<	DataType := FieldType;
3628	>	Name := FieldAliasName;
3629	>	FAliasNameMap[FieldNo-1] := DBAliasName;
3630		Size := FieldSize;
3631		Precision := FieldPrecision;
3632	<	Required := False;
3632	>	Required := not FieldNullable;
3633		InternalCalcField := False;
3634	+	CharacterSetSize := CharSetSize;
3635	+	CharacterSetName := CharSetName;
3636	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3637	+	CodePage := FieldCodePage;
3638	+	{$ENDIF}
3639		if (FieldName <> '') and (RelationName <> '') then
3640		begin
3641		if Has_COMPUTED_BLR(RelationName, FieldName) then
#	Line 3029 | Line 3715 | begin
3715		else case cur_field.DataType of
3716		ftString:
3717		cur_param.AsString := cur_field.AsString;
3718	<	ftBoolean, ftSmallint, ftWord:
3718	>	ftBoolean:
3719	>	cur_param.AsBoolean := cur_field.AsBoolean;
3720	>	ftSmallint, ftWord:
3721		cur_param.AsShort := cur_field.AsInteger;
3722		ftInteger:
3723		cur_param.AsLong := cur_field.AsInteger;
#	Line 3082 | Line 3770 | begin
3770		end;
3771
3772		procedure TIBCustomDataSet.InternalOpen;
3085	–	var
3086	–	SetCursor: Boolean;
3773
3774		function RecordDataLength(n: Integer): Long;
3775		begin
3776		result := SizeOf(TRecordData) + ((n - 1) * SizeOf(TFieldData));
3777		end;
3778
3779	+	function GetFieldDef(aFieldNo: integer): TIBFieldDef;
3780	+	var i: integer;
3781	+	begin
3782	+	Result := nil;
3783	+	for i := 0 to FieldDefs.Count - 1 do
3784	+	if FieldDefs[i].FieldNo = aFieldNo then
3785	+	begin
3786	+	Result := TIBFieldDef(FieldDefs[i]);
3787	+	break;
3788	+	end;
3789	+	end;
3790	+
3791	+	procedure SetExtendedProperties;
3792	+	var i: integer;
3793	+	IBFieldDef: TIBFieldDef;
3794	+	begin
3795	+	for i := 0 to Fields.Count - 1 do
3796	+	if Fields[i].FieldNo > 0 then
3797	+	begin
3798	+	if(Fields[i] is TIBStringField) then
3799	+	with TIBStringField(Fields[i]) do
3800	+	begin
3801	+	IBFieldDef := GetFieldDef(FieldNo);
3802	+	if IBFieldDef <> nil then
3803	+	begin
3804	+	CharacterSetSize := IBFieldDef.CharacterSetSize;
3805	+	CharacterSetName := IBFieldDef.CharacterSetName;
3806	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3807	+	CodePage := IBFieldDef.CodePage;
3808	+	{$ENDIF}
3809	+	end;
3810	+	end
3811	+	else
3812	+	if(Fields[i] is TIBMemoField) then
3813	+	with TIBMemoField(Fields[i]) do
3814	+	begin
3815	+	IBFieldDef := GetFieldDef(FieldNo);
3816	+	if IBFieldDef <> nil then
3817	+	begin
3818	+	CharacterSetSize := IBFieldDef.CharacterSetSize;
3819	+	CharacterSetName := IBFieldDef.CharacterSetName;
3820	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3821	+	CodePage := IBFieldDef.CodePage;
3822	+	{$ENDIF}
3823	+	end;
3824	+	end
3825	+	end
3826	+	end;
3827	+
3828		begin
3829	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3095	<	if SetCursor then
3096	<	Screen.Cursor := crHourGlass;
3829	>	FBase.SetCursor;
3830		try
3831		ActivateConnection;
3832		ActivateTransaction;
#	Line 3106 | Line 3839 | begin
3839		if DefaultFields then
3840		CreateFields;
3841		BindFields(True);
3842	+	SetExtendedProperties;
3843		FCurrentRecord := -1;
3844		FQSelect.ExecQuery;
3845		FOpen := FQSelect.Open;
#	Line 3154 | Line 3888 | begin
3888		else
3889		FQSelect.ExecQuery;
3890		finally
3891	<	if SetCursor and (Screen.Cursor = crHourGlass) then
3158	<	Screen.Cursor := crDefault;
3891	>	FBase.RestoreCursor;
3892		end;
3893		end;
3894
#	Line 3163 | Line 3896 | procedure TIBCustomDataSet.InternalPost;
3896		var
3897		Qry: TIBSQL;
3898		Buff: PChar;
3166	–	SetCursor: Boolean;
3899		bInserting: Boolean;
3900		begin
3901	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3170	<	if SetCursor then
3171	<	Screen.Cursor := crHourGlass;
3901	>	FBase.SetCursor;
3902		try
3903		Buff := GetActiveBuf;
3904		CheckEditState;
#	Line 3206 | Line 3936 | begin
3936		if bInserting then
3937		Inc(FRecordCount);
3938		finally
3939	<	if SetCursor and (Screen.Cursor = crHourGlass) then
3210	<	Screen.Cursor := crDefault;
3939	>	FBase.RestoreCursor;
3940		end;
3941		end;
3942
3943		procedure TIBCustomDataSet.InternalRefresh;
3944		begin
3945	<	inherited;
3945	>	inherited InternalRefresh;
3946		InternalRefreshRow;
3947		end;
3948
#	Line 3227 | Line 3956 | begin
3956		result := FOpen;
3957		end;
3958
3959	+	procedure TIBCustomDataSet.Loaded;
3960	+	begin
3961	+	if assigned(FQSelect) then
3962	+	FBaseSQLSelect.assign(FQSelect.SQL);
3963	+	inherited Loaded;
3964	+	end;
3965	+
3966	+	procedure TIBCustomDataSet.Post;
3967	+	var CancelPost: boolean;
3968	+	begin
3969	+	CancelPost := false;
3970	+	if assigned(FOnValidatePost) then
3971	+	OnValidatePost(self,CancelPost);
3972	+	if CancelPost then
3973	+	Cancel
3974	+	else
3975	+	inherited Post;
3976	+	end;
3977	+
3978		function TIBCustomDataSet.Locate(const KeyFields: string; const KeyValues: Variant;
3979		Options: TLocateOptions): Boolean;
3980		var
3981	+	{$IFDEF NEW_TBOOKMARK }
3982	+	CurBookmark: TBookmark;
3983	+	{$ELSE}
3984		CurBookmark: string;
3985	+	{$ENDIF}
3986		begin
3987		DisableControls;
3988		try
#	Line 3248 | Line 4000 | function TIBCustomDataSet.Lookup(const K
4000		const ResultFields: string): Variant;
4001		var
4002		fl: TList;
4003	+	{$IFDEF NEW_TBOOKMARK }
4004	+	CurBookmark: TBookmark;
4005	+	{$ELSE}
4006		CurBookmark: string;
4007	+	{$ENDIF}
4008		begin
4009		DisableControls;
4010		fl := TList.Create;
#	Line 3301 | Line 4057 | end;
4057		procedure TIBCustomDataSet.InternalSetFieldData(Field: TField; Buffer: Pointer);
4058		var
4059		Buff, TmpBuff: PChar;
4060	+	MappedFieldPos: integer;
4061		begin
4062		Buff := GetActiveBuf;
4063		if Field.FieldNo < 0 then
#	Line 3317 | Line 4074 | begin
4074		begin
4075		{ If inserting, Adjust record position }
4076		AdjustRecordOnInsert(Buff);
4077	<	if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and
4078	<	(FMappedFieldPosition[Field.FieldNo - 1] <= rdFieldCount) then
4077	>	MappedFieldPos := FMappedFieldPosition[Field.FieldNo - 1];
4078	>	if (MappedFieldPos > 0) and
4079	>	(MappedFieldPos <= rdFieldCount) then
4080		begin
4081		Field.Validate(Buffer);
4082		if (Buffer = nil) or
4083		(Field is TIBStringField) and (PChar(Buffer)[0] = #0) then
4084	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull := True
4084	>	rdFields[MappedFieldPos].fdIsNull := True
4085		else begin
4086	<	Move(Buffer^, Buff[rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs],
4087	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataSize);
4088	<	if (rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_TEXT) or
4089	<	(rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_VARYING) then
4090	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataLength := StrLen(PChar(Buffer));
4091	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull := False;
4086	>	Move(Buffer^, Buff[rdFields[MappedFieldPos].fdDataOfs],
4087	>	rdFields[MappedFieldPos].fdDataSize);
4088	>	if (rdFields[MappedFieldPos].fdDataType = SQL_TEXT) or
4089	>	(rdFields[MappedFieldPos].fdDataType = SQL_VARYING) then
4090	>	rdFields[MappedFieldPos].fdDataLength := StrLen(PChar(Buffer));
4091	>	rdFields[MappedFieldPos].fdIsNull := False;
4092		if rdUpdateStatus = usUnmodified then
4093		begin
4094		if CachedUpdates then
#	Line 3354 | Line 4112 | begin
4112		end;
4113		end;
4114		if not (State in [dsCalcFields, dsFilter, dsNewValue]) then
4115	<	DataEvent(deFieldChange, Longint(Field));
4115	>	DataEvent(deFieldChange, PtrInt(Field));
4116		end;
4117
4118		procedure TIBCustomDataSet.SetRecNo(Value: Integer);
#	Line 3418 | Line 4176 | begin
4176		FillChar(Buffer[FRecordSize], CalcFieldsSize, 0);
4177		end;
4178
4179	+	procedure TIBCustomDataSet.ClearIBLinks;
4180	+	var i: integer;
4181	+	begin
4182	+	for i := FIBLinks.Count - 1 downto 0 do
4183	+	TIBControlLink(FIBLinks[i]).IBDataSet := nil;
4184	+	end;
4185	+
4186
4187		procedure TIBCustomDataSet.InternalUnPrepare;
4188		begin
#	Line 3425 | Line 4190 | begin
4190		begin
4191		CheckDatasetClosed;
4192		FieldDefs.Clear;
4193	+	FieldDefs.Updated := false;
4194		FInternalPrepared := False;
4195	+	Setlength(FAliasNameList,0);
4196		end;
4197		end;
4198
4199		procedure TIBCustomDataSet.InternalExecQuery;
4200		var
4201		DidActivate: Boolean;
3435	–	SetCursor: Boolean;
4202		begin
4203		DidActivate := False;
4204	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3439	<	if SetCursor then
3440	<	Screen.Cursor := crHourGlass;
4204	>	FBase.SetCursor;
4205		try
4206		ActivateConnection;
4207		DidActivate := ActivateTransaction;
#	Line 3454 | Line 4218 | begin
4218		finally
4219		if DidActivate then
4220		DeactivateTransaction;
4221	<	if SetCursor and (Screen.Cursor = crHourGlass) then
3458	<	Screen.Cursor := crDefault;
4221	>	FBase.RestoreCursor;
4222		end;
4223		end;
4224
#	Line 3464 | Line 4227 | begin
4227		Result := FQSelect.Handle;
4228		end;
4229
4230	+	function TIBCustomDataSet.GetParser: TSelectSQLParser;
4231	+	begin
4232	+	if not assigned(FParser) then
4233	+	FParser := CreateParser;
4234	+	Result := FParser
4235	+	end;
4236	+
4237	+	procedure TIBCustomDataSet.ResetParser;
4238	+	begin
4239	+	if assigned(FParser) then
4240	+	begin
4241	+	FParser.Free;
4242	+	FParser := nil;
4243	+	FQSelect.OnSQLChanged := nil; {Do not react to change}
4244	+	try
4245	+	FQSelect.SQL.Assign(FBaseSQLSelect);
4246	+	finally
4247	+	FQSelect.OnSQLChanged := SQLChanged;
4248	+	end;
4249	+	end;
4250	+	end;
4251	+
4252	+	function TIBCustomDataSet.HasParser: boolean;
4253	+	begin
4254	+	Result := not (csDesigning in ComponentState) and (FParser <> nil)
4255	+	end;
4256	+
4257	+	procedure TIBCustomDataSet.SetGenerateParamNames(AValue: Boolean);
4258	+	begin
4259	+	if FGenerateParamNames = AValue then Exit;
4260	+	FGenerateParamNames := AValue;
4261	+	Disconnect
4262	+	end;
4263	+
4264		procedure TIBCustomDataSet.InitRecord(Buffer: PChar);
4265		begin
4266		inherited InitRecord(Buffer);
#	Line 3482 | Line 4279 | end;
4279
4280		{ TIBDataSet IProviderSupport }
4281
4282	<	procedure TIBCustomDataSet.PSEndTransaction(Commit: Boolean);
4282	>	(*procedure TIBCustomDataSet.PSEndTransaction(Commit: Boolean);
4283		begin
4284		if Commit then
4285		Transaction.Commit else
#	Line 3645 | Line 4442 | begin
4442		if not FQSelect.Prepared then
4443		FQSelect.Prepare;
4444		Result := FQSelect.UniqueRelationName;
4445	<	end;
4445	>	end;*)
4446
4447		procedure TIBDataSet.BatchInput(InputObject: TIBBatchInput);
4448		begin
#	Line 3682 | Line 4479 | begin
4479		ActivateConnection;
4480		ActivateTransaction;
4481		InternalSetParamsFromCursor;
4482	<	Inherited;
4482	>	Inherited InternalOpen;
4483		end;
4484
4485		procedure TIBDataSet.SetFiltered(Value: Boolean);
#	Line 3710 | Line 4507 | end;
4507
4508		function TIBCustomDataSet.GetFieldData(Field: TField;
4509		Buffer: Pointer): Boolean;
4510	+	{$IFDEF TBCDFIELD_IS_BCD}
4511		var
4512		lTempCurr : System.Currency;
4513		begin
#	Line 3720 | Line 4518 | begin
4518		CurrToBCD(lTempCurr, TBCD(Buffer^), 32, Field.Size);
4519		end
4520		else
4521	+	{$ELSE}
4522	+	begin
4523	+	{$ENDIF}
4524		Result := InternalGetFieldData(Field, Buffer);
4525		end;
4526
#	Line 3733 | Line 4534 | begin
4534		end;
4535
4536		procedure TIBCustomDataSet.SetFieldData(Field: TField; Buffer: Pointer);
4537	+	{$IFDEF TDBDFIELD_IS_BCD}
4538		var
4539		lTempCurr : System.Currency;
4540		begin
4541	<	if Field.DataType = ftBCD then
4541	>	if (Field.DataType = ftBCD) and (Buffer <> nil) then
4542		begin
4543		BCDToCurr(TBCD(Buffer^), lTempCurr);
4544		InternalSetFieldData(Field, @lTempCurr);
4545		end
4546		else
4547	+	{$ELSE}
4548	+	begin
4549	+	{$ENDIF}
4550		InternalSetFieldData(Field, Buffer);
4551		end;
4552
#	Line 3765 | Line 4570 | end;
4570		destructor TIBDataSetUpdateObject.Destroy;
4571		begin
4572		FRefreshSQL.Free;
4573	<	inherited destroy;
4573	>	inherited Destroy;
4574		end;
4575
4576		procedure TIBDataSetUpdateObject.SetRefreshSQL(Value: TStrings);
#	Line 3773 | Line 4578 | begin
4578		FRefreshSQL.Assign(Value);
4579		end;
4580
4581	+	procedure TIBDataSetUpdateObject.InternalSetParams(Query: TIBSQL; buff: PChar);
4582	+	begin
4583	+	if not Assigned(DataSet) then Exit;
4584	+	DataSet.SetInternalSQLParams(Query, buff);
4585	+	end;
4586	+
4587	+	function TIBDSBlobStream.GetSize: Int64;
4588	+	begin
4589	+	Result := FBlobStream.BlobSize;
4590	+	end;
4591	+
4592		{ TIBDSBlobStream }
4593		constructor TIBDSBlobStream.Create(AField: TField; ABlobStream: TIBBlobStream;
4594		Mode: TBlobStreamMode);
#	Line 3781 | Line 4597 | begin
4597		FBlobStream := ABlobStream;
4598		FBlobStream.Seek(0, soFromBeginning);
4599		if (Mode = bmWrite) then
4600	+	begin
4601		FBlobStream.Truncate;
4602	+	TIBCustomDataSet(FField.DataSet).RecordModified(True);
4603	+	TBlobField(FField).Modified := true;
4604	+	FHasWritten := true;
4605	+	end;
4606	+	end;
4607	+
4608	+	destructor TIBDSBlobStream.Destroy;
4609	+	begin
4610	+	if FHasWritten then
4611	+	TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
4612	+	inherited Destroy;
4613		end;
4614
4615		function TIBDSBlobStream.Read(var Buffer; Count: Longint): Longint;
#	Line 3804 | Line 4632 | begin
4632		if not (FField.DataSet.State in [dsEdit, dsInsert]) then
4633		IBError(ibxeNotEditing, [nil]);
4634		TIBCustomDataSet(FField.DataSet).RecordModified(True);
4635	+	TBlobField(FField).Modified := true;
4636		result := FBlobStream.Write(Buffer, Count);
4637	<	TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, Longint(FField));
4637	>	FHasWritten := true;
4638	>	{  TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
4639	>	Removed as this caused a seek to beginning of the blob stream thus corrupting
4640	>	the blob stream. Moved to the destructor i.e. called after blob written}
4641		end;
4642
4643	+	{ TIBGenerator }
4644	+
4645	+	procedure TIBGenerator.SetIncrement(const AValue: integer);
4646	+	begin
4647	+	if AValue < 0 then
4648	+	raise Exception.Create('A Generator Increment cannot be negative');
4649	+	FIncrement := AValue
4650	+	end;
4651	+
4652	+	function TIBGenerator.GetNextValue(ADatabase: TIBDatabase;
4653	+	ATransaction: TIBTransaction): integer;
4654	+	begin
4655	+	with TIBSQL.Create(nil) do
4656	+	try
4657	+	Database := ADatabase;
4658	+	Transaction := ATransaction;
4659	+	if not assigned(Database) then
4660	+	IBError(ibxeCannotSetDatabase,[]);
4661	+	if not assigned(Transaction) then
4662	+	IBError(ibxeCannotSetTransaction,[]);
4663	+	with Transaction do
4664	+	if not InTransaction then StartTransaction;
4665	+	SQL.Text := Format('Select Gen_ID(%s,%d) as ID From RDB$Database',[FGeneratorName,Increment]);
4666	+	Prepare;
4667	+	ExecQuery;
4668	+	try
4669	+	Result := FieldByName('ID').AsInteger
4670	+	finally
4671	+	Close
4672	+	end;
4673	+	finally
4674	+	Free
4675	+	end;
4676	+	end;
4677	+
4678	+	constructor TIBGenerator.Create(Owner: TIBCustomDataSet);
4679	+	begin
4680	+	FOwner := Owner;
4681	+	FIncrement := 1;
4682	+	end;
4683	+
4684	+
4685	+	procedure TIBGenerator.Apply;
4686	+	begin
4687	+	if (FGeneratorName <> '') and (FFieldName <> '') and Owner.FieldByName(FFieldName).IsNull then
4688	+	Owner.FieldByName(FFieldName).AsInteger := GetNextValue(Owner.Database,Owner.Transaction);
4689	+	end;
4690	+
4691	+
4692		end.

Diff Legend

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