ViewVC Help

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

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

Comparing ibx/trunk/runtime/IBCustomDataSet.pas (file contents):
Revision 5 by tony, Fri Feb 18 16:26:16 2011 UTC vs.
Revision 39 by tony, Tue May 17 08:14:52 2016 UTC

#	Line 24 | Line 24
24		{       Corporation. All Rights Reserved.                                }
25		{    Contributor(s): Jeff Overcash                                       }
26		{                                                                        }
27	+	{    IBX For Lazarus (Firebird Express)                                  }
28	+	{    Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
29	+	{    Portions created by MWA Software are copyright McCallum Whyman      }
30	+	{    Associates Ltd 2011 - 2015                                                }
31	+	{                                                                        }
32		{************************************************************************}
33
34		unit IBCustomDataSet;
35
36	+	{$IF FPC_FULLVERSION >= 20700 }
37	+	{$codepage UTF8}
38	+	{$DEFINE HAS_ANSISTRING_CODEPAGE}
39	+	{$DEFINE NEW_TBOOKMARK}
40	+	{$ENDIF}
41	+
42	+	{$R-}
43	+
44		{$Mode Delphi}
45
46	+	{$IFDEF DELPHI}
47	+	{$DEFINE TDBDFIELD_IS_BCD}
48	+	{$ENDIF}
49	+
50		interface
51
52		uses
53	<	{$IFDEF LINUX }
37	<	unix,
38	<	{$ELSE}
53	>	{$IFDEF WINDOWS }
54		Windows,
55	+	{$ELSE}
56	+	unix,
57		{$ENDIF}
58	<	SysUtils, Classes, Forms, Controls, IBDatabase,
59	<	IBExternals, IB, IBHeader,  IBSQL, Db,
43	<	IBUtils, IBBlob;
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 50 | Line 66 | type
66		TIBCustomDataSet = class;
67		TIBDataSet = class;
68
69	+	{ TIBDataSetUpdateObject }
70	+
71		TIBDataSetUpdateObject = class(TComponent)
72		private
73		FRefreshSQL: TStrings;
#	Line 57 | 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 94 | 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 106 | 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 135 | 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 159 | Line 253 | type
253		FFieldName: string;
254		FGeneratorName: string;
255		FIncrement: integer;
162	–	function GetSelectSQL: string;
256		procedure SetIncrement(const AValue: integer);
257		protected
258		function GetNextValue(ADatabase: TIBDatabase; ATransaction: TIBTransaction): integer;
#	Line 167 | Line 260 | type
260		constructor Create(Owner: TIBCustomDataSet);
261		procedure Apply;
262		property Owner: TIBCustomDataSet read FOwner;
170	–	property SelectSQL: string read GetSelectSQL;
263		published
264	<	property GeneratorName: string read FGeneratorName write FGeneratorName;
265	<	property FieldName: string read FFieldName write FFieldName;
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	<	FGenerator: TIBGenerator;
303	>	FAutoCommit: TIBAutoCommit;
304	>	FGenerateParamNames: Boolean;
305	>	FGeneratorField: TIBGenerator;
306		FNeedsRefresh: Boolean;
307		FForcedRefresh: Boolean;
308		FDidActivate: Boolean;
#	Line 213 | Line 327 | type
327		FDeletedRecords: Long;
328		FModelBuffer,
329		FOldBuffer: PChar;
330	+	FOnValidatePost: TOnValidatePost;
331		FOpen: Boolean;
332		FInternalPrepared: Boolean;
333		FQDelete,
#	Line 223 | 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 240 | 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 253 | 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 273 | Line 396 | type
396		function GetModifySQL: TStrings;
397		function GetTransaction: TIBTransaction;
398		function GetTRHandle: PISC_TR_HANDLE;
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); 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 292 | Line 418 | type
418		procedure SetUpdateRecordTypes(Value: TIBUpdateRecordTypes);
419		procedure SetUniDirectional(Value: Boolean);
420		procedure RefreshParams;
295	–	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 311 | 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); virtual;
443		procedure InternalBatchOutput(OutputObject: TIBBatchOutput); virtual;
#	Line 320 | Line 447 | type
447		procedure InternalRefreshRow; virtual;
448		procedure InternalSetParamsFromCursor; virtual;
449		procedure CheckNotUniDirectional;
450	+	procedure SQLChanging(Sender: TObject); virtual;
451	+	procedure SQLChanged(Sender: TObject); virtual;
452
453		(*    { IProviderSupport }
454		procedure PSEndTransaction(Commit: Boolean); override;
#	Line 343 | 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;
#	Line 375 | Line 512 | type
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 387 | 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 402 | 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 Generator: TIBGenerator read FGenerator write FGenerator;
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 410 | 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 423 | 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 430 | 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 446 | Line 592 | type
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 497 | 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 522 | 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 532 | Line 689 | type
689		property RefreshSQL;
690		property SelectSQL;
691		property ModifySQL;
692	<	property Generator;
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 571 | Line 730 | type
730		property OnFilterRecord;
731		property OnNewRecord;
732		property OnPostError;
733	+	property OnValidatePost;
734		end;
735
736		{ TIBDSBlobStream }
737		TIBDSBlobStream = class(TStream)
738	+	private
739	+	FHasWritten: boolean;
740		protected
741		FField: TField;
742		FBlobStream: TIBBlobStream;
743		public
744		constructor Create(AField: TField; ABlobStream: TIBBlobStream;
745		Mode: TBlobStreamMode);
746	+	destructor Destroy; override;
747		function Read(var Buffer; Count: Longint): Longint; override;
748		function Seek(Offset: Longint; Origin: Word): Longint; override;
749		procedure SetSize(NewSize: Longint); override;
#	Line 605 | Line 768 | DefaultFieldClasses: array[TFieldType] o
768		TVarBytesField,     { ftVarBytes }
769		TAutoIncField,      { ftAutoInc }
770		TBlobField,         { ftBlob }
771	<	TMemoField,         { ftMemo }
771	>	TIBMemoField,       { ftMemo }
772		TGraphicField,      { ftGraphic }
773		TBlobField,         { ftFmtMemo }
774		TBlobField,         { ftParadoxOle }
#	Line 613 | Line 776 | DefaultFieldClasses: array[TFieldType] o
776		TBlobField,         { ftTypedBinary }
777		nil,                { ftCursor }
778		TStringField,       { ftFixedChar }
779	<	TWideStringField,    { ftWideString }
779	>	TIBWideStringField,    { ftWideString }
780		TLargeIntField,     { ftLargeInt }
781		nil,          { ftADT }
782		nil,        { ftArray }
#	Line 628 | Line 791 | DefaultFieldClasses: array[TFieldType] o
791		TDateTimeField,    {ftTimestamp}
792		TIBBCDField,       {ftFMTBcd}
793		nil,  {ftFixedWideChar}
794	<	TWideMemoField);   {ftWideMemo}
795	<
796	<	(*    TADTField,          { ftADT }
794	>	TIBWideMemoField);   {ftWideMemo}
795	>	(*
796	>	TADTField,          { ftADT }
797		TArrayField,        { ftArray }
798		TReferenceField,    { ftReference }
799		TDataSetField,     { ftDataSet }
#	Line 639 | Line 802 | DefaultFieldClasses: array[TFieldType] o
802		TVariantField,      { ftVariant }
803		TInterfaceField,    { ftInterface }
804		TIDispatchField,     { ftIDispatch }
805	<	TGuidField);        { ftGuid }*)
805	>	TGuidField);        { ftGuid } *)
806		(*var
807		CreateProviderProc: function(DataSet: TIBCustomDataSet): IProvider = nil;*)
808
809		implementation
810
811	<	uses IBIntf, Variants, FmtBCD;
811	>	uses IBIntf, Variants, FmtBCD, LazUTF8;
812
813		const FILE_BEGIN = 0;
814		FILE_CURRENT = 1;
#	Line 668 | Line 831 | type
831		NextRelation : TRelationNode;
832		end;
833
834	+	{Extended Field Def for character set info}
835
836	<	{ TIBStringField}
836	>	{ TIBFieldDef }
837
838	<	constructor TIBStringField.Create(AOwner: TComponent);
838	>	TIBFieldDef = class(TFieldDef)
839	>	private
840	>	FCharacterSetName: RawByteString;
841	>	FCharacterSetSize: integer;
842	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
843	>	FCodePage: TSystemCodePage;
844	>	{$ENDIF}
845	>	published
846	>	property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
847	>	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
848	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
849	>	property CodePage: TSystemCodePage read FCodePage write FCodePage;
850	>	{$ENDIF}
851	>	end;
852	>
853	>
854	>	{  Copied from LCLProc in order to avoid LCL dependency
855	>
856	>	Ensures the covenient look of multiline string
857	>	when displaying it in the single line
858	>	* Replaces CR and LF with spaces
859	>	* Removes duplicate spaces
860	>	}
861	>	function TextToSingleLine(const AText: string): string;
862	>	var
863	>	str: string;
864	>	i, wstart, wlen: Integer;
865	>	begin
866	>	str := Trim(AText);
867	>	wstart := 0;
868	>	wlen := 0;
869	>	i := 1;
870	>	while i < Length(str) - 1 do
871	>	begin
872	>	if (str[i] in [' ', #13, #10]) then
873	>	begin
874	>	if (wstart = 0) then
875	>	begin
876	>	wstart := i;
877	>	wlen := 1;
878	>	end else
879	>	Inc(wlen);
880	>	end else
881	>	begin
882	>	if wstart > 0 then
883	>	begin
884	>	str[wstart] := ' ';
885	>	Delete(str, wstart+1, wlen-1);
886	>	Dec(i, wlen-1);
887	>	wstart := 0;
888	>	end;
889	>	end;
890	>	Inc(i);
891	>	end;
892	>	Result := str;
893	>	end;
894	>
895	>	{ TIBWideMemoField }
896	>
897	>	function TIBWideMemoField.GetTruncatedText: string;
898	>	begin
899	>	Result := GetAsString;
900	>
901	>	if Result <> '' then
902	>	if DisplayWidth = 0 then
903	>	Result := TextToSingleLine(Result)
904	>	else
905	>	if Length(Result) > DisplayWidth then {Show truncation with elipses}
906	>	Result := TextToSingleLine(system.copy(Result,1,DisplayWidth-3)) + '...';
907	>	end;
908	>
909	>	function TIBWideMemoField.GetDefaultWidth: Longint;
910	>	begin
911	>	Result := 128;
912	>	end;
913	>
914	>	procedure TIBWideMemoField.GetText(var AText: string; ADisplayText: Boolean);
915	>	begin
916	>	if ADisplayText then
917	>	begin
918	>	if not DisplayTextAsClassName and (CharacterSetName<> '') then
919	>	AText := GetTruncatedText
920	>	else
921	>	inherited GetText(AText, ADisplayText);
922	>	end
923	>	else
924	>	AText := GetAsString;
925	>	end;
926	>
927	>	constructor TIBWideMemoField.Create(AOwner: TComponent);
928		begin
929		inherited Create(AOwner);
930	+	BlobType := ftWideMemo;
931	+	end;
932	+
933	+	{ TIBMemoField }
934	+
935	+	function TIBMemoField.GetTruncatedText: string;
936	+	begin
937	+	Result := GetAsString;
938	+
939	+	if Result <> '' then
940	+	begin
941	+	case CharacterSetSize of
942	+	1:
943	+	if DisplayWidth = 0 then
944	+	Result := TextToSingleLine(Result)
945	+	else
946	+	if Length(Result) > DisplayWidth then {Show truncation with elipses}
947	+	Result := TextToSingleLine(system.copy(Result,1,DisplayWidth-3)) + '...';
948	+
949	+	{2: case 2 ignored. This should be handled by TIBWideMemo}
950	+
951	+	3, {Assume UNICODE_FSS is really UTF8}
952	+	4: {Include GB18030 - assuming UTF8 routine work for this codeset}
953	+	if DisplayWidth = 0 then
954	+	Result := ValidUTF8String(TextToSingleLine(Result))
955	+	else
956	+	if UTF8Length(Result) > DisplayWidth then {Show truncation with elipses}
957	+	Result := ValidUTF8String(TextToSingleLine(UTF8Copy(Result,1,DisplayWidth-3))) + '...';
958	+	end;
959	+	end
960	+	end;
961	+
962	+	function TIBMemoField.GetAsString: string;
963	+	var s: RawByteString;
964	+	begin
965	+	s := inherited GetAsString;
966	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
967	+	SetCodePage(s,CodePage,false);
968	+	{$ENDIF}
969	+	Result := s;
970	+	end;
971	+
972	+	function TIBMemoField.GetDefaultWidth: Longint;
973	+	begin
974	+	if DisplayTextAsClassName then
975	+	Result := inherited
976	+	else
977	+	Result := 128;
978	+	end;
979	+
980	+	procedure TIBMemoField.GetText(var AText: string; ADisplayText: Boolean);
981	+	begin
982	+	if ADisplayText then
983	+	begin
984	+	if not DisplayTextAsClassName and (CharacterSetName <> '') then
985	+	AText := GetTruncatedText
986	+	else
987	+	inherited GetText(AText, ADisplayText);
988	+	end
989	+	else
990	+	AText := GetAsString;
991	+	end;
992	+
993	+	procedure TIBMemoField.SetAsString(const AValue: string);
994	+	var s: RawByteString;
995	+	begin
996	+	s := AValue;
997	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
998	+	if StringCodePage(Value) <> CodePage then
999	+	SetCodePage(s,CodePage,true);
1000	+	{$ENDIF}
1001	+	inherited SetAsString(s);
1002	+	end;
1003	+
1004	+	constructor TIBMemoField.Create(AOwner: TComponent);
1005	+	begin
1006	+	inherited Create(AOwner);
1007	+	BlobType := ftMemo;
1008	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1009	+	FCodePage := CP_NONE;
1010	+	{$ENDIF}
1011	+	end;
1012	+
1013	+	{ TIBControlLink }
1014	+
1015	+	destructor TIBControlLink.Destroy;
1016	+	begin
1017	+	IBDataSet := nil;
1018	+	inherited Destroy;
1019	+	end;
1020	+
1021	+	procedure TIBControlLink.UpdateParams(Sender: TObject);
1022	+	begin
1023	+
1024	+	end;
1025	+
1026	+	procedure TIBControlLink.UpdateSQL(Sender: TObject);
1027	+	begin
1028	+
1029	+	end;
1030	+
1031	+	procedure TIBControlLink.SetIBDataSet(AValue: TIBCustomDataSet);
1032	+	begin
1033	+	if FTIBDataSet = AValue then Exit;
1034	+	if IBDataSet <> nil then
1035	+	IBDataSet.UnRegisterIBLink(self);
1036	+	FTIBDataSet := AValue;
1037	+	if IBDataSet <> nil then
1038	+	IBDataSet.RegisterIBLink(self);
1039	+	end;
1040	+
1041	+
1042	+	{ TIBStringField}
1043	+
1044	+	function TIBStringField.GetDefaultWidth: Longint;
1045	+	begin
1046	+	Result := Size div CharacterSetSize;
1047	+	end;
1048	+
1049	+	constructor TIBStringField.Create(aOwner: TComponent);
1050	+	begin
1051	+	inherited Create(aOwner);
1052	+	FCharacterSetSize := 1;
1053	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1054	+	FCodePage := CP_NONE;
1055	+	{$ENDIF}
1056		end;
1057
1058		class procedure TIBStringField.CheckTypeSize(Value: Integer);
#	Line 696 | Line 1075 | end;
1075		function TIBStringField.GetValue(var Value: string): Boolean;
1076		var
1077		Buffer: PChar;
1078	+	s: RawByteString;
1079		begin
1080		Buffer := nil;
1081		IBAlloc(Buffer, 0, Size + 1);
#	Line 703 | Line 1083 | begin
1083		Result := GetData(Buffer);
1084		if Result then
1085		begin
1086	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1087	+	s := string(Buffer);
1088	+	SetCodePage(s,CodePage,false);
1089	+	Value := s;
1090	+	//      writeln(FieldName,': ', StringCodePage(Value),', ',Value);
1091	+	{$ELSE}
1092		Value := string(Buffer);
1093	+	{$ENDIF}
1094		if Transliterate and (Value <> '') then
1095		DataSet.Translate(PChar(Value), PChar(Value), False);
1096		end
#	Line 715 | Line 1102 | end;
1102		procedure TIBStringField.SetAsString(const Value: string);
1103		var
1104		Buffer: PChar;
1105	+	s: RawByteString;
1106		begin
1107		Buffer := nil;
1108		IBAlloc(Buffer, 0, Size + 1);
1109		try
1110	<	StrLCopy(Buffer, PChar(Value), Size);
1110	>	s := Value;
1111	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1112	>	if StringCodePage(s) <> CodePage then
1113	>	SetCodePage(s,CodePage,true);
1114	>	{$ENDIF}
1115	>	StrLCopy(Buffer, PChar(s), Size);
1116		if Transliterate then
1117		DataSet.Translate(Buffer, Buffer, True);
1118		SetData(Buffer);
#	Line 728 | Line 1121 | begin
1121		end;
1122		end;
1123
1124	+
1125		{ TIBBCDField }
1126
1127		constructor TIBBCDField.Create(AOwner: TComponent);
#	Line 770 | Line 1164 | end;
1164
1165		function TIBBCDField.GetDataSize: Integer;
1166		begin
1167	+	{$IFDEF TBCDFIELD_IS_BCD}
1168		Result := 8;
1169	+	{$ELSE}
1170	+	Result := inherited GetDataSize
1171	+	{$ENDIF}
1172		end;
1173
1174		{ TIBDataLink }
#	Line 821 | Line 1219 | begin
1219		CheckIBLoaded;
1220		FIBLoaded := True;
1221		FBase := TIBBase.Create(Self);
1222	+	FIBLinks := TList.Create;
1223		FCurrentRecord := -1;
1224		FDeletedRecords := 0;
1225		FUniDirectional := False;
1226		FBufferChunks := BufferCacheSize;
1227		FBlobStreamList := TList.Create;
1228	<	FGenerator := TIBGenerator.Create(self);
1228	>	FGeneratorField := TIBGenerator.Create(self);
1229		FDataLink := TIBDataLink.Create(Self);
1230		FQDelete := TIBSQL.Create(Self);
1231		FQDelete.OnSQLChanging := SQLChanging;
#	Line 839 | Line 1238 | begin
1238		FQRefresh.GoToFirstRecordOnExecute := False;
1239		FQSelect := TIBSQL.Create(Self);
1240		FQSelect.OnSQLChanging := SQLChanging;
1241	+	FQSelect.OnSQLChanged := SQLChanged;
1242		FQSelect.GoToFirstRecordOnExecute := False;
1243		FQModify := TIBSQL.Create(Self);
1244		FQModify.OnSQLChanging := SQLChanging;
1245		FQModify.GoToFirstRecordOnExecute := False;
1246		FUpdateRecordTypes := [cusUnmodified, cusModified, cusInserted];
1247		FParamCheck := True;
1248	+	FGenerateParamNames := False;
1249		FForcedRefresh := False;
1250	+	FAutoCommit:= acDisabled;
1251	+	FDataSetCloseAction := dcDiscardChanges;
1252		{Bookmark Size is Integer for IBX}
1253		BookmarkSize := SizeOf(Integer);
1254		FBase.BeforeDatabaseDisconnect := DoBeforeDatabaseDisconnect;
#	Line 859 | Line 1262 | begin
1262		else
1263		if AOwner is TIBTransaction then
1264		Transaction := TIBTransaction(AOwner);
1265	+	FBaseSQLSelect := TStringList.Create;
1266		end;
1267
1268		destructor TIBCustomDataSet.Destroy;
1269		begin
1270	+	if Active then Active := false;
1271		if FIBLoaded then
1272		begin
1273	<	if assigned(FGenerator) then FGenerator.Free;
1273	>	if assigned(FGeneratorField) then FGeneratorField.Free;
1274		FDataLink.Free;
1275		FBase.Free;
1276		ClearBlobCache;
1277	+	ClearIBLinks;
1278	+	FIBLinks.Free;
1279		FBlobStreamList.Free;
1280		FreeMem(FBufferCache);
1281		FBufferCache := nil;
#	Line 878 | Line 1285 | begin
1285		FOldCacheSize := 0;
1286		FMappedFieldPosition := nil;
1287		end;
1288	+	if assigned(FBaseSQLSelect) then FBaseSQLSelect.Free;
1289	+	if assigned(FParser) then FParser.Free;
1290		inherited Destroy;
1291		end;
1292
#	Line 919 | Line 1328 | end;
1328
1329		procedure TIBCustomDataSet.ApplyUpdates;
1330		var
1331	+	{$IFDEF NEW_TBOOKMARK }
1332	+	CurBookmark: TBookmark;
1333	+	{$ELSE}
1334		CurBookmark: string;
1335	+	{$ENDIF}
1336		Buffer: PRecordData;
1337		CurUpdateTypes: TIBUpdateRecordTypes;
1338		UpdateAction: TIBUpdateAction;
#	Line 979 | Line 1392 | var
1392		procedure UpdateUsingUpdateObject;
1393		begin
1394		try
1395	<	FUpdateObject.Apply(UpdateKind);
1395	>	FUpdateObject.Apply(UpdateKind,PChar(Buffer));
1396		ResetBufferUpdateStatus;
1397		except
1398		on E: Exception do
#	Line 1117 | Line 1530 | begin
1530		end;
1531		end;
1532
1533	+	function TIBCustomDataSet.GetFieldPosition(AliasName: string): integer;
1534	+	var i: integer;
1535	+	Prepared: boolean;
1536	+	begin
1537	+	Result := 0;
1538	+	Prepared := FInternalPrepared;
1539	+	if not Prepared then
1540	+	InternalPrepare;
1541	+	try
1542	+	for i := 0 to Length(FAliasNameList) - 1 do
1543	+	if FAliasNameList[i] = AliasName then
1544	+	begin
1545	+	Result := i + 1;
1546	+	Exit
1547	+	end;
1548	+	finally
1549	+	if not Prepared then
1550	+	InternalUnPrepare;
1551	+	end;
1552	+	end;
1553	+
1554		procedure TIBCustomDataSet.ActivateConnection;
1555		begin
1556		if not Assigned(Database) then
#	Line 1177 | Line 1611 | begin
1611		IBError(ibxeDatasetClosed, [nil]);
1612		end;
1613
1614	+	function TIBCustomDataSet.CreateParser: TSelectSQLParser;
1615	+	begin
1616	+	Result := TSelectSQLParser.Create(self,FBaseSQLSelect);
1617	+	Result.OnSQLChanging := SQLChanging
1618	+	end;
1619	+
1620		procedure TIBCustomDataSet.CheckNotUniDirectional;
1621		begin
1622		if UniDirectional then
#	Line 1280 | Line 1720 | begin
1720		FDatabaseFree(Sender);
1721		end;
1722
1723	<	procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject);
1723	>	procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject;
1724	>	Action: TTransactionAction);
1725		begin
1726	<	if Active then
1727	<	Active := False;
1726	>	FCloseAction := Action;
1727	>	FInTransactionEnd := true;
1728	>	try
1729	>	if Active then
1730	>	Active := False;
1731	>	finally
1732	>	FInTransactionEnd := false;
1733	>	end;
1734		if FQSelect <> nil then
1735		FQSelect.FreeHandle;
1736		if FQDelete <> nil then
#	Line 1321 | Line 1768 | var
1768		LocalData: Pointer;
1769		LocalDate, LocalDouble: Double;
1770		LocalInt: Integer;
1771	+	LocalBool: wordBool;
1772		LocalInt64: Int64;
1773		LocalCurrency: Currency;
1774		FieldsLoaded: Integer;
#	Line 1465 | Line 1913 | begin
1913		end;
1914		end;
1915		end;
1916	+	SQL_BOOLEAN:
1917	+	begin
1918	+	LocalBool:= false;
1919	+	rdFields[j].fdDataSize := SizeOf(wordBool);
1920	+	if RecordNumber >= 0 then
1921	+	LocalBool := Qry.Current[i].AsBoolean;
1922	+	LocalData := PChar(@LocalBool);
1923	+	end;
1924		else { SQL_TEXT, SQL_BLOB, SQL_ARRAY, SQL_QUAD }
1925		begin
1926		rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
#	Line 1589 | Line 2045 | end;
2045		procedure TIBCustomDataSet.InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer);
2046		begin
2047		if (Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukDelete).Text <> '')) then
2048	<	FUpdateObject.Apply(ukDelete)
2048	>	FUpdateObject.Apply(ukDelete,Buff)
2049		else
2050		begin
2051		SetInternalSQLParams(FQDelete, Buff);
#	Line 1606 | Line 2062 | end;
2062		function TIBCustomDataSet.InternalLocate(const KeyFields: string;
2063		const KeyValues: Variant; Options: TLocateOptions): Boolean;
2064		var
2065	<	fl: TList;
2065	>	keyFieldList: TList;
2066	>	{$IFDEF NEW_TBOOKMARK }
2067	>	CurBookmark: TBookmark;
2068	>	{$ELSE}
2069		CurBookmark: string;
2070	<	fld, val: Variant;
2071	<	i, fld_cnt: Integer;
2070	>	{$ENDIF}
2071	>	fieldValue: Variant;
2072	>	lookupValues: array of variant;
2073	>	i, fieldCount: Integer;
2074	>	fieldValueAsString: string;
2075	>	lookupValueAsString: string;
2076		begin
2077	<	fl := TList.Create;
2077	>	keyFieldList := TList.Create;
2078		try
2079	<	GetFieldList(fl, KeyFields);
2080	<	fld_cnt := fl.Count;
2079	>	GetFieldList(keyFieldList, KeyFields);
2080	>	fieldCount := keyFieldList.Count;
2081		CurBookmark := Bookmark;
2082	<	result := False;
2083	<	while ((not result) and (not EOF)) do
2082	>	result := false;
2083	>	SetLength(lookupValues, fieldCount);
2084	>	if not EOF then
2085		begin
2086	<	i := 0;
1623	<	result := True;
1624	<	while (result and (i < fld_cnt)) do
2086	>	for i := 0 to fieldCount - 1 do  {expand key values into lookupValues array}
2087		begin
2088	<	if fld_cnt > 1 then
2089	<	val := KeyValues[i]
2088	>	if VarIsArray(KeyValues) then
2089	>	lookupValues[i] := KeyValues[i]
2090	>	else
2091	>	if i > 0 then
2092	>	lookupValues[i] := NULL
2093		else
2094	<	val := KeyValues;
2095	<	fld := TField(fl[i]).Value;
2096	<	result := not (VarIsNull(val) xor VarIsNull(fld));
2097	<	if result and not VarIsNull(val) then
2094	>	lookupValues[0] := KeyValues;
2095	>
2096	>	{convert to upper case is case insensitive search}
2097	>	if (TField(keyFieldList[i]).DataType = ftString) and
2098	>	not VarIsNull(lookupValues[i]) and (loCaseInsensitive in Options) then
2099	>	lookupValues[i] := UpperCase(lookupValues[i]);
2100	>	end;
2101	>	end;
2102	>	while not result and not EOF do   {search for a matching record}
2103	>	begin
2104	>	i := 0;
2105	>	result := true;
2106	>	while result and (i < fieldCount) do
2107	>	{see if all of the key fields matches}
2108	>	begin
2109	>	fieldValue := TField(keyFieldList[i]).Value;
2110	>	result := not (VarIsNull(fieldValue) xor VarIsNull(lookupValues[i]));
2111	>	if result and not VarIsNull(fieldValue) then
2112		begin
2113		try
2114	<	fld := VarAsType(fld, VarType(val));
1636	<	except
1637	<	on E: EVariantError do result := False;
1638	<	end;
1639	<	if Result then
1640	<	if TField(fl[i]).DataType = ftString then
2114	>	if TField(keyFieldList[i]).DataType = ftString then
2115		begin
2116	+	{strings need special handling because of the locate options that
2117	+	apply to them}
2118	+	fieldValueAsString := TField(keyFieldList[i]).AsString;
2119	+	lookupValueAsString := lookupValues[i];
2120		if (loCaseInsensitive in Options) then
2121	<	begin
2122	<	fld := AnsiUpperCase(fld);
1645	<	val := AnsiUpperCase(val);
1646	<	end;
1647	<	fld := TrimRight(fld);
1648	<	val := TrimRight(val);
2121	>	fieldValueAsString := UpperCase(fieldValueAsString);
2122	>
2123		if (loPartialKey in Options) then
2124	<	result := result and (AnsiPos(val, fld) = 1)
2124	>	result := result and (Pos(lookupValueAsString, fieldValueAsString) = 1)
2125		else
2126	<	result := result and (val = fld);
2127	<	end else
2128	<	result := result and (val = fld);
2126	>	result := result and (fieldValueAsString = lookupValueAsString);
2127	>	end
2128	>	else
2129	>	result := result and (lookupValues[i] =
2130	>	VarAsType(fieldValue, VarType(lookupValues[i])));
2131	>	except on EVariantError do
2132	>	result := False;
2133	>	end;
2134		end;
2135		Inc(i);
2136		end;
2137		if not result then
2138	<	Next;
2138	>	Next;
2139		end;
2140		if not result then
2141		Bookmark := CurBookmark
2142		else
2143		CursorPosChanged;
2144		finally
2145	<	fl.Free;
2145	>	keyFieldList.Free;
2146	>	SetLength(lookupValues,0)
2147		end;
2148		end;
2149
#	Line 1691 | Line 2171 | begin
2171		if Assigned(FUpdateObject) then
2172		begin
2173		if (Qry = FQDelete) then
2174	<	FUpdateObject.Apply(ukDelete)
2174	>	FUpdateObject.Apply(ukDelete,Buff)
2175		else if (Qry = FQInsert) then
2176	<	FUpdateObject.Apply(ukInsert)
2176	>	FUpdateObject.Apply(ukInsert,Buff)
2177		else
2178	<	FUpdateObject.Apply(ukModify);
2178	>	FUpdateObject.Apply(ukModify,Buff);
2179		end
2180		else begin
2181		SetInternalSQLParams(Qry, Buff);
#	Line 1712 | Line 2192 | end;
2192		procedure TIBCustomDataSet.InternalRefreshRow;
2193		var
2194		Buff: PChar;
1715	–	SetCursor: Boolean;
2195		ofs: DWORD;
2196		Qry: TIBSQL;
2197		begin
2198	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1720	<	if SetCursor then
1721	<	Screen.Cursor := crHourGlass;
2198	>	FBase.SetCursor;
2199		try
2200		Buff := GetActiveBuf;
2201		if CanRefresh then
#	Line 1762 | Line 2239 | begin
2239		else
2240		IBError(ibxeCannotRefresh, [nil]);
2241		finally
2242	<	if SetCursor and (Screen.Cursor = crHourGlass) then
1766	<	Screen.Cursor := crDefault;
2242	>	FBase.RestoreCursor;
2243		end;
2244		end;
2245
#	Line 1834 | Line 2310 | end;
2310
2311		procedure TIBCustomDataSet.InternalPrepare;
2312		var
1837	–	SetCursor: Boolean;
2313		DidActivate: Boolean;
2314		begin
2315		if FInternalPrepared then
2316		Exit;
2317		DidActivate := False;
2318	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1844	<	if SetCursor then
1845	<	Screen.Cursor := crHourGlass;
2318	>	FBase.SetCursor;
2319		try
2320		ActivateConnection;
2321		DidActivate := ActivateTransaction;
2322		FBase.CheckDatabase;
2323		FBase.CheckTransaction;
2324	+	if HasParser and (FParser.SQLText <> FQSelect.SQL.Text) then
2325	+	begin
2326	+	FQSelect.OnSQLChanged := nil; {Do not react to change}
2327	+	try
2328	+	FQSelect.SQL.Text := FParser.SQLText;
2329	+	finally
2330	+	FQSelect.OnSQLChanged := SQLChanged;
2331	+	end;
2332	+	end;
2333	+	//   writeln( FQSelect.SQL.Text);
2334		if FQSelect.SQL.Text <> '' then
2335		begin
2336		if not FQSelect.Prepared then
2337		begin
2338	+	FQSelect.GenerateParamNames := FGenerateParamNames;
2339		FQSelect.ParamCheck := ParamCheck;
2340		FQSelect.Prepare;
2341		end;
2342	<	if (FQDelete.SQL.Text <> '') and (not FQDelete.Prepared) then
2342	>	FQDelete.GenerateParamNames := FGenerateParamNames;
2343	>	if (Trim(FQDelete.SQL.Text) <> '') and (not FQDelete.Prepared) then
2344		FQDelete.Prepare;
2345	<	if (FQInsert.SQL.Text <> '') and (not FQInsert.Prepared) then
2345	>	FQInsert.GenerateParamNames := FGenerateParamNames;
2346	>	if (Trim(FQInsert.SQL.Text) <> '') and (not FQInsert.Prepared) then
2347		FQInsert.Prepare;
2348	<	if (FQRefresh.SQL.Text <> '') and (not FQRefresh.Prepared) then
2348	>	FQRefresh.GenerateParamNames := FGenerateParamNames;
2349	>	if (Trim(FQRefresh.SQL.Text) <> '') and (not FQRefresh.Prepared) then
2350		FQRefresh.Prepare;
2351	<	if (FQModify.SQL.Text <> '') and (not FQModify.Prepared) then
2351	>	FQModify.GenerateParamNames := FGenerateParamNames;
2352	>	if (Trim(FQModify.SQL.Text) <> '') and (not FQModify.Prepared) then
2353		FQModify.Prepare;
2354		FInternalPrepared := True;
2355		InternalInitFieldDefs;
#	Line 1870 | Line 2358 | begin
2358		finally
2359		if DidActivate then
2360		DeactivateTransaction;
2361	<	if SetCursor and (Screen.Cursor = crHourGlass) then
1874	<	Screen.Cursor := crDefault;
2361	>	FBase.RestoreCursor;
2362		end;
2363		end;
2364
#	Line 2061 | Line 2548 | begin
2548		end;
2549		SQL_TIMESTAMP:
2550		Qry.Params[i].AsDateTime :=
2551	<	TimeStampToDateTime(
2552	<	MSecsToTimeStamp(PDouble(data)^));
2551	>	TimeStampToDateTime(MSecsToTimeStamp(trunc(PDouble(data)^)));
2552	>	SQL_BOOLEAN:
2553	>	Qry.Params[i].AsBoolean := PWordBool(data)^;
2554		end;
2555		end;
2556		end;
#	Line 2148 | Line 2636 | begin
2636		end;
2637		end;
2638
2639	+	procedure TIBCustomDataSet.RegisterIBLink(Sender: TIBControlLink);
2640	+	begin
2641	+	if FIBLinks.IndexOf(Sender) = -1 then
2642	+	FIBLinks.Add(Sender);
2643	+	end;
2644	+
2645
2646		procedure TIBCustomDataSet.SQLChanging(Sender: TObject);
2647		begin
2648	<	if FOpen then
2649	<	InternalClose;
2648	>	Active := false;
2649	>	{  if FOpen then
2650	>	InternalClose;}
2651		if FInternalPrepared then
2652		InternalUnPrepare;
2653	+	FieldDefs.Clear;
2654	+	FieldDefs.Updated := false;
2655	+	end;
2656	+
2657	+	procedure TIBCustomDataSet.SQLChanged(Sender: TObject);
2658	+	begin
2659	+	FBaseSQLSelect.assign(FQSelect.SQL);
2660		end;
2661
2662		{ I can "undelete" uninserted records (make them "inserted" again).
#	Line 2183 | Line 2685 | begin
2685		end;
2686		end;
2687
2688	+	procedure TIBCustomDataSet.UnRegisterIBLink(Sender: TIBControlLink);
2689	+	begin
2690	+	FIBLinks.Remove(Sender);
2691	+	end;
2692	+
2693		function TIBCustomDataSet.UpdateStatus: TUpdateStatus;
2694		begin
2695		if Active then
#	Line 2199 | Line 2706 | begin
2706		Result := Assigned( FQSelect ) and FQSelect.EOF;
2707		end;
2708
2709	+	function TIBCustomDataSet.ParamByName(ParamName: String): TIBXSQLVAR;
2710	+	begin
2711	+	ActivateConnection;
2712	+	ActivateTransaction;
2713	+	if not FInternalPrepared then
2714	+	InternalPrepare;
2715	+	Result := Params.ByName(ParamName);
2716	+	end;
2717	+
2718	+	{Beware: the parameter FCache is used as an identifier to determine which
2719	+	cache is being operated on and is not referenced in the computation.
2720	+	The result is an adjusted offset into the identified cache, either the
2721	+	Buffer Cache or the old Buffer Cache.}
2722	+
2723		function TIBCustomDataSet.AdjustPosition(FCache: PChar; Offset: DWORD;
2724	<	Origin: Integer): Integer;
2724	>	Origin: Integer): DWORD;
2725		var
2726		OldCacheSize: Integer;
2727		begin
#	Line 2237 | Line 2758 | procedure TIBCustomDataSet.ReadCache(FCa
2758		Buffer: PChar);
2759		var
2760		pCache: PChar;
2761	+	AdjustedOffset: DWORD;
2762		bOld: Boolean;
2763		begin
2764		bOld := (FCache = FOldBufferCache);
2765	<	pCache := PChar(AdjustPosition(FCache, Offset, Origin));
2765	>	AdjustedOffset := AdjustPosition(FCache, Offset, Origin);
2766		if not bOld then
2767	<	pCache := FBufferCache + Integer(pCache)
2767	>	pCache := FBufferCache + AdjustedOffset
2768		else
2769	<	pCache := FOldBufferCache + Integer(pCache);
2769	>	pCache := FOldBufferCache + AdjustedOffset;
2770		Move(pCache^, Buffer^, DWORD(FRecordBufferSize));
2771		AdjustPosition(FCache, FRecordBufferSize, FILE_CURRENT);
2772		end;
#	Line 2274 | Line 2796 | procedure TIBCustomDataSet.WriteCache(FC
2796		Buffer: PChar);
2797		var
2798		pCache: PChar;
2799	+	AdjustedOffset: DWORD;
2800		bOld: Boolean;
2801		dwEnd: DWORD;
2802		begin
2803		bOld := (FCache = FOldBufferCache);
2804	<	pCache := PChar(AdjustPosition(FCache, Offset, Origin));
2804	>	AdjustedOffset := AdjustPosition(FCache, Offset, Origin);
2805		if not bOld then
2806	<	pCache := FBufferCache + Integer(pCache)
2806	>	pCache := FBufferCache + AdjustedOffset
2807		else
2808	<	pCache := FOldBufferCache + Integer(pCache);
2808	>	pCache := FOldBufferCache + AdjustedOffset;
2809		Move(Buffer^, pCache^, FRecordBufferSize);
2810		dwEnd := AdjustPosition(FCache, FRecordBufferSize, FILE_CURRENT);
2811		if not bOld then
#	Line 2396 | Line 2919 | begin
2919		inherited DoBeforeDelete;
2920		end;
2921
2922	+	procedure TIBCustomDataSet.DoAfterDelete;
2923	+	begin
2924	+	inherited DoAfterDelete;
2925	+	FBase.DoAfterDelete(self);
2926	+	InternalAutoCommit;
2927	+	end;
2928	+
2929		procedure TIBCustomDataSet.DoBeforeEdit;
2930		var
2931		Buff: PRecordData;
#	Line 2410 | Line 2940 | begin
2940		inherited DoBeforeEdit;
2941		end;
2942
2943	+	procedure TIBCustomDataSet.DoAfterEdit;
2944	+	begin
2945	+	inherited DoAfterEdit;
2946	+	FBase.DoAfterEdit(self);
2947	+	end;
2948	+
2949		procedure TIBCustomDataSet.DoBeforeInsert;
2950		begin
2951		if not CanInsert then
#	Line 2419 | Line 2955 | end;
2955
2956		procedure TIBCustomDataSet.DoAfterInsert;
2957		begin
2958	<	if Generator.ApplyOnEvent = gaeOnNewRecord then
2959	<	Generator.Apply;
2958	>	if GeneratorField.ApplyOnEvent = gaeOnNewRecord then
2959	>	GeneratorField.Apply;
2960		inherited DoAfterInsert;
2961	+	FBase.DoAfterInsert(self);
2962	+	end;
2963	+
2964	+	procedure TIBCustomDataSet.DoBeforeClose;
2965	+	begin
2966	+	inherited DoBeforeClose;
2967	+	if State in [dsInsert,dsEdit] then
2968	+	begin
2969	+	if FInTransactionEnd and (FCloseAction = TARollback) then
2970	+	Exit;
2971	+
2972	+	if DataSetCloseAction = dcSaveChanges then
2973	+	Post;
2974	+	{Note this can fail with an exception e.g. due to
2975	+	database validation error. In which case the dataset remains open }
2976	+	end;
2977	+	end;
2978	+
2979	+	procedure TIBCustomDataSet.DoBeforeOpen;
2980	+	var i: integer;
2981	+	begin
2982	+	if assigned(FParser) then
2983	+	FParser.Reset;
2984	+	for i := 0 to FIBLinks.Count - 1 do
2985	+	TIBControlLink(FIBLinks[i]).UpdateSQL(self);
2986	+	inherited DoBeforeOpen;
2987	+	for i := 0 to FIBLinks.Count - 1 do
2988	+	TIBControlLink(FIBLinks[i]).UpdateParams(self);
2989		end;
2990
2991		procedure TIBCustomDataSet.DoBeforePost;
2992		begin
2993		inherited DoBeforePost;
2994		if (State = dsInsert) and
2995	<	(Generator.ApplyOnEvent = gaeOnPostRecord) then
2996	<	Generator.Apply
2995	>	(GeneratorField.ApplyOnEvent = gaeOnPostRecord) then
2996	>	GeneratorField.Apply
2997	>	end;
2998	>
2999	>	procedure TIBCustomDataSet.DoAfterPost;
3000	>	begin
3001	>	inherited DoAfterPost;
3002	>	FBase.DoAfterPost(self);
3003	>	InternalAutoCommit;
3004		end;
3005
3006		procedure TIBCustomDataSet.FetchAll;
3007		var
3008	<	SetCursor: Boolean;
3008	>	{$IFDEF NEW_TBOOKMARK }
3009	>	CurBookmark: TBookmark;
3010	>	{$ELSE}
3011		CurBookmark: string;
3012	+	{$ENDIF}
3013		begin
3014	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3015	<	if SetCursor then
2442	<	Screen.Cursor := crHourGlass;
2443	<	try
3014	>	FBase.SetCursor;
3015	>	try
3016		if FQSelect.EOF or not FQSelect.Open then
3017		exit;
3018		DisableControls;
#	Line 2452 | Line 3024 | begin
3024		EnableControls;
3025		end;
3026		finally
3027	<	if SetCursor and (Screen.Cursor = crHourGlass) then
2456	<	Screen.Cursor := crDefault;
3027	>	FBase.RestoreCursor;
3028		end;
3029		end;
3030
#	Line 2501 | Line 3072 | begin
3072		result := FDataLink.DataSource;
3073		end;
3074
3075	+	function TIBCustomDataSet.GetDBAliasName(FieldNo: integer): string;
3076	+	begin
3077	+	Result := FAliasNameMap[FieldNo-1]
3078	+	end;
3079	+
3080	+	function TIBCustomDataSet.GetFieldDefFromAlias(aliasName: string): TFieldDef;
3081	+	var
3082	+	i: integer;
3083	+	begin
3084	+	Result := nil;
3085	+	for i := 0 to Length(FAliasNameMap) - 1 do
3086	+	if FAliasNameMap[i] = aliasName then
3087	+	begin
3088	+	Result := FieldDefs[i];
3089	+	Exit
3090	+	end;
3091	+	end;
3092	+
3093		function TIBCustomDataSet.GetFieldClass(FieldType: TFieldType): TFieldClass;
3094		begin
3095		Result := DefaultFieldClasses[FieldType];
#	Line 2519 | Line 3108 | begin
3108		result := False;
3109		Buff := GetActiveBuf;
3110		if (Buff = nil) or
3111	<	(not IsVisible(Buff)) then
3111	>	(not IsVisible(Buff)) or not assigned(Field.DataSet) then
3112		exit;
3113		{ The intention here is to stuff the buffer with the data for the
3114		referenced field for the current record }
#	Line 2541 | Line 3130 | begin
3130		Data := Buff + CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs;
3131		if (fdDataType = SQL_VARYING) or (fdDataType = SQL_TEXT) then
3132		begin
3133	<	Move(Data^, Buffer^, fdDataLength);
3134	<	PChar(Buffer)[fdDataLength] := #0;
3133	>	if fdDataLength < Field.DataSize then
3134	>	begin
3135	>	Move(Data^, Buffer^, fdDataLength);
3136	>	PChar(Buffer)[fdDataLength] := #0;
3137	>	end
3138	>	else
3139	>	IBError(ibxeFieldSizeError,[Field.FieldName])
3140		end
3141		else
3142		Move(Data^, Buffer^, Field.DataSize);
#	Line 2585 | Line 3179 | begin
3179		if not Accept and (GetMode = gmCurrent) then
3180		GetMode := gmPrior;
3181		except
3182	<	//        Application.HandleException(Self);
3182	>	//        FBase.HandleException(Self);
3183		end;
3184		end;
3185		RestoreState(SaveState);
#	Line 2679 | Line 3273 | begin
3273		result := FRecordBufferSize;
3274		end;
3275
3276	+	procedure TIBCustomDataSet.InternalAutoCommit;
3277	+	begin
3278	+	with Transaction do
3279	+	if InTransaction and (FAutoCommit = acCommitRetaining) then
3280	+	begin
3281	+	if CachedUpdates then ApplyUpdates;
3282	+	CommitRetaining;
3283	+	end;
3284	+	end;
3285	+
3286		procedure TIBCustomDataSet.InternalAddRecord(Buffer: Pointer; Append: Boolean);
3287		begin
3288		CheckEditState;
#	Line 2750 | Line 3354 | begin
3354		FreeMem(FOldBufferCache);
3355		FOldBufferCache := nil;
3356		BindFields(False);
3357	+	ResetParser;
3358		if DefaultFields then DestroyFields;
3359		end;
3360
3361		procedure TIBCustomDataSet.InternalDelete;
3362		var
3363		Buff: PChar;
2759	–	SetCursor: Boolean;
3364		begin
3365	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
2762	<	if SetCursor then
2763	<	Screen.Cursor := crHourGlass;
3365	>	FBase.SetCursor;
3366		try
3367		Buff := GetActiveBuf;
3368		if CanDelete then
#	Line 2785 | Line 3387 | begin
3387		end else
3388		IBError(ibxeCannotDelete, [nil]);
3389		finally
3390	<	if SetCursor and (Screen.Cursor = crHourGlass) then
2789	<	Screen.Cursor := crDefault;
3390	>	FBase.RestoreCursor;
3391		end;
3392		end;
3393
#	Line 2802 | Line 3403 | end;
3403
3404		procedure TIBCustomDataSet.InternalHandleException;
3405		begin
3406	<	Application.HandleException(Self)
3406	>	FBase.HandleException(Self)
3407		end;
3408
3409		procedure TIBCustomDataSet.InternalInitFieldDefs;
3410	+	begin
3411	+	if not InternalPrepared then
3412	+	begin
3413	+	InternalPrepare;
3414	+	exit;
3415	+	end;
3416	+	FieldDefsFromQuery(FQSelect);
3417	+	end;
3418	+
3419	+	procedure TIBCustomDataSet.FieldDefsFromQuery(SourceQuery: TIBSQL);
3420		const
3421		DefaultSQL = 'Select F.RDB$COMPUTED_BLR, ' + {do not localize}
3422		'F.RDB$DEFAULT_VALUE, R.RDB$FIELD_NAME ' + {do not localize}
#	Line 2817 | Line 3428 | const
3428		var
3429		FieldType: TFieldType;
3430		FieldSize: Word;
3431	+	charSetID: short;
3432	+	CharSetSize: integer;
3433	+	CharSetName: RawByteString;
3434	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3435	+	FieldCodePage: TSystemCodePage;
3436	+	{$ENDIF}
3437		FieldNullable : Boolean;
3438		i, FieldPosition, FieldPrecision: Integer;
3439	<	FieldAliasName: string;
3439	>	FieldAliasName, DBAliasName: string;
3440		RelationName, FieldName: string;
3441		Query : TIBSQL;
3442		FieldIndex: Integer;
#	Line 2919 | Line 3536 | var
3536		end;
3537
3538		begin
2922	–	if not InternalPrepared then
2923	–	begin
2924	–	InternalPrepare;
2925	–	exit;
2926	–	end;
3539		FRelationNodes := TRelationNode.Create;
3540		FNeedsRefresh := False;
3541		Database.InternalTransaction.StartTransaction;
#	Line 2934 | Line 3546 | begin
3546		FieldDefs.BeginUpdate;
3547		FieldDefs.Clear;
3548		FieldIndex := 0;
3549	<	if (Length(FMappedFieldPosition) < FQSelect.Current.Count) then
3550	<	SetLength(FMappedFieldPosition, FQSelect.Current.Count);
3549	>	if (Length(FMappedFieldPosition) < SourceQuery.Current.Count) then
3550	>	SetLength(FMappedFieldPosition, SourceQuery.Current.Count);
3551		Query.SQL.Text := DefaultSQL;
3552		Query.Prepare;
3553	<	for i := 0 to FQSelect.Current.Count - 1 do
3554	<	with FQSelect.Current[i].Data^ do
3553	>	SetLength(FAliasNameMap, SourceQuery.Current.Count);
3554	>	SetLength(FAliasNameList, SourceQuery.Current.Count);
3555	>	for i := 0 to SourceQuery.Current.Count - 1 do
3556	>	with SourceQuery.Current[i].Data^ do
3557		begin
3558		{ Get the field name }
3559	<	SetString(FieldAliasName, aliasname, aliasname_length);
3559	>	FieldAliasName := SourceQuery.Current[i].Name;
3560	>	SetString(DBAliasName, aliasname, aliasname_length);
3561		SetString(RelationName, relname, relname_length);
3562		SetString(FieldName, sqlname, sqlname_length);
3563	+	FAliasNameList[i] := DBAliasName;
3564		FieldSize := 0;
3565		FieldPrecision := 0;
3566	<	FieldNullable := FQSelect.Current[i].IsNullable;
3566	>	FieldNullable := SourceQuery.Current[i].IsNullable;
3567	>	CharSetSize := 0;
3568	>	CharSetName := '';
3569	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3570	>	FieldCodePage := CP_NONE;
3571	>	{$ENDIF}
3572		case sqltype and not 1 of
3573		{ All VARCHAR's must be converted to strings before recording
3574		their values }
3575		SQL_VARYING, SQL_TEXT:
3576		begin
3577	+	CharSetSize := FBase.GetCharSetSize(sqlsubtype and $FF);
3578	+	CharSetName := FBase.GetCharSetName(sqlsubtype and $FF);
3579	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3580	+	FieldCodePage := FBase.GetCodePage(sqlsubtype and $FF);
3581	+	{$ENDIF}
3582	+	{FieldSize is encoded for strings - see TIBStringField.SetSize for decode}
3583		FieldSize := sqllen;
3584	<	FieldType := ftString;
3584	>	if CharSetSize = 2 then
3585	>	FieldType := ftWideString
3586	>	else
3587	>	FieldType := ftString;
3588		end;
3589		{ All Doubles/Floats should be cast to doubles }
3590		SQL_DOUBLE, SQL_FLOAT:
#	Line 2980 | Line 3610 | begin
3610		FieldSize := -sqlscale;
3611		end
3612		else
3613	<	FieldType := ftFloat;
3613	>	if Database.SQLDialect = 1 then
3614	>	FieldType := ftFloat
3615	>	else
3616	>	if (FieldCount > i) and (Fields[i] is TFloatField) then
3617	>	FieldType := ftFloat
3618	>	else
3619	>	begin
3620	>	FieldType := ftFMTBCD;
3621	>	FieldPrecision := 9;
3622	>	FieldSize := -sqlscale;
3623		end;
3624	+	end;
3625	+
3626		SQL_INT64:
3627		begin
3628		if (sqlscale = 0) then
#	Line 2993 | Line 3634 | begin
3634		FieldSize := -sqlscale;
3635		end
3636		else
3637	<	FieldType := ftFloat;
3638	<	end;
3637	>	FieldType := ftFloat
3638	>	end;
3639		SQL_TIMESTAMP: FieldType := ftDateTime;
3640		SQL_TYPE_TIME: FieldType := ftTime;
3641		SQL_TYPE_DATE: FieldType := ftDate;
#	Line 3002 | Line 3643 | begin
3643		begin
3644		FieldSize := sizeof (TISC_QUAD);
3645		if (sqlsubtype = 1) then
3646	<	FieldType := ftmemo
3646	>	begin
3647	>	if FBase.GetDefaultCharSetName <> '' then
3648	>	begin
3649	>	CharSetSize := FBase.GetDefaultCharSetSize;
3650	>	CharSetName := FBase.GetDefaultCharSetName;
3651	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3652	>	FieldCodePage := FBase.GetDefaultCodePage;
3653	>	{$ENDIF}
3654	>	end
3655	>	else
3656	>	if strpas(sqlname) <> '' then
3657	>	begin
3658	>	charSetID := GetBlobCharSetID(Database.Handle,Database.InternalTransaction.Handle,
3659	>	@relname,@sqlname);
3660	>	CharSetSize := FBase.GetCharSetSize(charSetID);
3661	>	CharSetName := FBase.GetCharSetName(charSetID);
3662	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3663	>	FieldCodePage := FBase.GetCodePage(charSetID);
3664	>	{$ENDIF}
3665	>	end
3666	>	else  {Complex SQL with no identifiable column and no connection default}
3667	>	begin
3668	>	CharSetName := '';
3669	>	CharSetSize := 1;
3670	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3671	>	FieldCodePage := CP_NONE;
3672	>	{$ENDIF}
3673	>	end;
3674	>	if CharSetSize = 2 then
3675	>	FieldType := ftWideMemo
3676	>	else
3677	>	FieldType := ftMemo;
3678	>	end
3679		else
3680		FieldType := ftBlob;
3681		end;
#	Line 3011 | Line 3684 | begin
3684		FieldSize := sizeof (TISC_QUAD);
3685		FieldType := ftUnknown;
3686		end;
3687	+	SQL_BOOLEAN:
3688	+	FieldType:= ftBoolean;
3689		else
3690		FieldType := ftUnknown;
3691		end;
#	Line 3019 | Line 3694 | begin
3694		begin
3695		FMappedFieldPosition[FieldIndex] := FieldPosition;
3696		Inc(FieldIndex);
3697	<	with FieldDefs.AddFieldDef do
3697	>	with TIBFieldDef.Create(FieldDefs,'',FieldType,0,False,FieldDefs.Count+1) do
3698		begin
3699	<	Name := string( FieldAliasName );
3700	<	(*           FieldNo := FieldPosition;*)
3026	<	DataType := FieldType;
3699	>	Name := FieldAliasName;
3700	>	FAliasNameMap[FieldNo-1] := DBAliasName;
3701		Size := FieldSize;
3702		Precision := FieldPrecision;
3703		Required := not FieldNullable;
3704		InternalCalcField := False;
3705	+	CharacterSetSize := CharSetSize;
3706	+	CharacterSetName := CharSetName;
3707	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3708	+	CodePage := FieldCodePage;
3709	+	{$ENDIF}
3710		if (FieldName <> '') and (RelationName <> '') then
3711		begin
3712		if Has_COMPUTED_BLR(RelationName, FieldName) then
#	Line 3107 | Line 3786 | begin
3786		else case cur_field.DataType of
3787		ftString:
3788		cur_param.AsString := cur_field.AsString;
3789	<	ftBoolean, ftSmallint, ftWord:
3789	>	ftBoolean:
3790	>	cur_param.AsBoolean := cur_field.AsBoolean;
3791	>	ftSmallint, ftWord:
3792		cur_param.AsShort := cur_field.AsInteger;
3793		ftInteger:
3794		cur_param.AsLong := cur_field.AsInteger;
#	Line 3160 | Line 3841 | begin
3841		end;
3842
3843		procedure TIBCustomDataSet.InternalOpen;
3163	–	var
3164	–	SetCursor: Boolean;
3844
3845		function RecordDataLength(n: Integer): Long;
3846		begin
3847		result := SizeOf(TRecordData) + ((n - 1) * SizeOf(TFieldData));
3848		end;
3849
3850	+	function GetFieldDef(aFieldNo: integer): TIBFieldDef;
3851	+	var i: integer;
3852	+	begin
3853	+	Result := nil;
3854	+	for i := 0 to FieldDefs.Count - 1 do
3855	+	if FieldDefs[i].FieldNo = aFieldNo then
3856	+	begin
3857	+	Result := TIBFieldDef(FieldDefs[i]);
3858	+	break;
3859	+	end;
3860	+	end;
3861	+
3862	+	procedure SetExtendedProperties;
3863	+	var i: integer;
3864	+	IBFieldDef: TIBFieldDef;
3865	+	begin
3866	+	for i := 0 to Fields.Count - 1 do
3867	+	if Fields[i].FieldNo > 0 then
3868	+	begin
3869	+	if(Fields[i] is TIBStringField) then
3870	+	with TIBStringField(Fields[i]) do
3871	+	begin
3872	+	IBFieldDef := GetFieldDef(FieldNo);
3873	+	if IBFieldDef <> nil then
3874	+	begin
3875	+	CharacterSetSize := IBFieldDef.CharacterSetSize;
3876	+	CharacterSetName := IBFieldDef.CharacterSetName;
3877	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3878	+	CodePage := IBFieldDef.CodePage;
3879	+	{$ENDIF}
3880	+	end;
3881	+	end
3882	+	else
3883	+	if(Fields[i] is TIBWideStringField) then
3884	+	with TIBWideStringField(Fields[i]) do
3885	+	begin
3886	+	IBFieldDef := GetFieldDef(FieldNo);
3887	+	if IBFieldDef <> nil then
3888	+	begin
3889	+	CharacterSetSize := IBFieldDef.CharacterSetSize;
3890	+	CharacterSetName := IBFieldDef.CharacterSetName;
3891	+	end;
3892	+	end
3893	+	else
3894	+	if(Fields[i] is TIBMemoField) then
3895	+	with TIBMemoField(Fields[i]) do
3896	+	begin
3897	+	IBFieldDef := GetFieldDef(FieldNo);
3898	+	if IBFieldDef <> nil then
3899	+	begin
3900	+	CharacterSetSize := IBFieldDef.CharacterSetSize;
3901	+	CharacterSetName := IBFieldDef.CharacterSetName;
3902	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3903	+	CodePage := IBFieldDef.CodePage;
3904	+	{$ENDIF}
3905	+	end;
3906	+	end
3907	+	else
3908	+	if(Fields[i] is TIBWideMemoField) then
3909	+	with TIBWideMemoField(Fields[i]) do
3910	+	begin
3911	+	IBFieldDef := GetFieldDef(FieldNo);
3912	+	if IBFieldDef <> nil then
3913	+	begin
3914	+	CharacterSetSize := IBFieldDef.CharacterSetSize;
3915	+	CharacterSetName := IBFieldDef.CharacterSetName;
3916	+	end;
3917	+	end
3918	+	end
3919	+	end;
3920	+
3921		begin
3922	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3173	<	if SetCursor then
3174	<	Screen.Cursor := crHourGlass;
3922	>	FBase.SetCursor;
3923		try
3924		ActivateConnection;
3925		ActivateTransaction;
#	Line 3184 | Line 3932 | begin
3932		if DefaultFields then
3933		CreateFields;
3934		BindFields(True);
3935	+	SetExtendedProperties;
3936		FCurrentRecord := -1;
3937		FQSelect.ExecQuery;
3938		FOpen := FQSelect.Open;
#	Line 3232 | Line 3981 | begin
3981		else
3982		FQSelect.ExecQuery;
3983		finally
3984	<	if SetCursor and (Screen.Cursor = crHourGlass) then
3236	<	Screen.Cursor := crDefault;
3984	>	FBase.RestoreCursor;
3985		end;
3986		end;
3987
#	Line 3241 | Line 3989 | procedure TIBCustomDataSet.InternalPost;
3989		var
3990		Qry: TIBSQL;
3991		Buff: PChar;
3244	–	SetCursor: Boolean;
3992		bInserting: Boolean;
3993		begin
3994	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3248	<	if SetCursor then
3249	<	Screen.Cursor := crHourGlass;
3994	>	FBase.SetCursor;
3995		try
3996		Buff := GetActiveBuf;
3997		CheckEditState;
#	Line 3284 | Line 4029 | begin
4029		if bInserting then
4030		Inc(FRecordCount);
4031		finally
4032	<	if SetCursor and (Screen.Cursor = crHourGlass) then
3288	<	Screen.Cursor := crDefault;
4032	>	FBase.RestoreCursor;
4033		end;
4034		end;
4035
#	Line 3305 | Line 4049 | begin
4049		result := FOpen;
4050		end;
4051
4052	+	procedure TIBCustomDataSet.Loaded;
4053	+	begin
4054	+	if assigned(FQSelect) then
4055	+	FBaseSQLSelect.assign(FQSelect.SQL);
4056	+	inherited Loaded;
4057	+	end;
4058	+
4059	+	procedure TIBCustomDataSet.Post;
4060	+	var CancelPost: boolean;
4061	+	begin
4062	+	CancelPost := false;
4063	+	if assigned(FOnValidatePost) then
4064	+	OnValidatePost(self,CancelPost);
4065	+	if CancelPost then
4066	+	Cancel
4067	+	else
4068	+	inherited Post;
4069	+	end;
4070	+
4071		function TIBCustomDataSet.Locate(const KeyFields: string; const KeyValues: Variant;
4072		Options: TLocateOptions): Boolean;
4073		var
4074	+	{$IFDEF NEW_TBOOKMARK }
4075	+	CurBookmark: TBookmark;
4076	+	{$ELSE}
4077		CurBookmark: string;
4078	+	{$ENDIF}
4079		begin
4080		DisableControls;
4081		try
#	Line 3326 | Line 4093 | function TIBCustomDataSet.Lookup(const K
4093		const ResultFields: string): Variant;
4094		var
4095		fl: TList;
4096	+	{$IFDEF NEW_TBOOKMARK }
4097	+	CurBookmark: TBookmark;
4098	+	{$ELSE}
4099		CurBookmark: string;
4100	+	{$ENDIF}
4101		begin
4102		DisableControls;
4103		fl := TList.Create;
#	Line 3379 | Line 4150 | end;
4150		procedure TIBCustomDataSet.InternalSetFieldData(Field: TField; Buffer: Pointer);
4151		var
4152		Buff, TmpBuff: PChar;
4153	+	MappedFieldPos: integer;
4154		begin
4155		Buff := GetActiveBuf;
4156		if Field.FieldNo < 0 then
#	Line 3395 | Line 4167 | begin
4167		begin
4168		{ If inserting, Adjust record position }
4169		AdjustRecordOnInsert(Buff);
4170	<	if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and
4171	<	(FMappedFieldPosition[Field.FieldNo - 1] <= rdFieldCount) then
4170	>	MappedFieldPos := FMappedFieldPosition[Field.FieldNo - 1];
4171	>	if (MappedFieldPos > 0) and
4172	>	(MappedFieldPos <= rdFieldCount) then
4173		begin
4174		Field.Validate(Buffer);
4175		if (Buffer = nil) or
4176		(Field is TIBStringField) and (PChar(Buffer)[0] = #0) then
4177	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull := True
4177	>	rdFields[MappedFieldPos].fdIsNull := True
4178		else begin
4179	<	Move(Buffer^, Buff[rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs],
4180	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataSize);
4181	<	if (rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_TEXT) or
4182	<	(rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_VARYING) then
4183	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataLength := StrLen(PChar(Buffer));
4184	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull := False;
4179	>	Move(Buffer^, Buff[rdFields[MappedFieldPos].fdDataOfs],
4180	>	rdFields[MappedFieldPos].fdDataSize);
4181	>	if (rdFields[MappedFieldPos].fdDataType = SQL_TEXT) or
4182	>	(rdFields[MappedFieldPos].fdDataType = SQL_VARYING) then
4183	>	rdFields[MappedFieldPos].fdDataLength := StrLen(PChar(Buffer));
4184	>	rdFields[MappedFieldPos].fdIsNull := False;
4185		if rdUpdateStatus = usUnmodified then
4186		begin
4187		if CachedUpdates then
#	Line 3432 | Line 4205 | begin
4205		end;
4206		end;
4207		if not (State in [dsCalcFields, dsFilter, dsNewValue]) then
4208	<	DataEvent(deFieldChange, Longint(Field));
4208	>	DataEvent(deFieldChange, PtrInt(Field));
4209		end;
4210
4211		procedure TIBCustomDataSet.SetRecNo(Value: Integer);
#	Line 3496 | Line 4269 | begin
4269		FillChar(Buffer[FRecordSize], CalcFieldsSize, 0);
4270		end;
4271
4272	+	procedure TIBCustomDataSet.ClearIBLinks;
4273	+	var i: integer;
4274	+	begin
4275	+	for i := FIBLinks.Count - 1 downto 0 do
4276	+	TIBControlLink(FIBLinks[i]).IBDataSet := nil;
4277	+	end;
4278	+
4279
4280		procedure TIBCustomDataSet.InternalUnPrepare;
4281		begin
#	Line 3503 | Line 4283 | begin
4283		begin
4284		CheckDatasetClosed;
4285		FieldDefs.Clear;
4286	+	FieldDefs.Updated := false;
4287		FInternalPrepared := False;
4288	+	Setlength(FAliasNameList,0);
4289		end;
4290		end;
4291
4292		procedure TIBCustomDataSet.InternalExecQuery;
4293		var
4294		DidActivate: Boolean;
3513	–	SetCursor: Boolean;
4295		begin
4296		DidActivate := False;
4297	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3517	<	if SetCursor then
3518	<	Screen.Cursor := crHourGlass;
4297	>	FBase.SetCursor;
4298		try
4299		ActivateConnection;
4300		DidActivate := ActivateTransaction;
#	Line 3532 | Line 4311 | begin
4311		finally
4312		if DidActivate then
4313		DeactivateTransaction;
4314	<	if SetCursor and (Screen.Cursor = crHourGlass) then
3536	<	Screen.Cursor := crDefault;
4314	>	FBase.RestoreCursor;
4315		end;
4316		end;
4317
#	Line 3542 | Line 4320 | begin
4320		Result := FQSelect.Handle;
4321		end;
4322
4323	+	function TIBCustomDataSet.GetParser: TSelectSQLParser;
4324	+	begin
4325	+	if not assigned(FParser) then
4326	+	FParser := CreateParser;
4327	+	Result := FParser
4328	+	end;
4329	+
4330	+	procedure TIBCustomDataSet.ResetParser;
4331	+	begin
4332	+	if assigned(FParser) then
4333	+	begin
4334	+	FParser.Free;
4335	+	FParser := nil;
4336	+	FQSelect.OnSQLChanged := nil; {Do not react to change}
4337	+	try
4338	+	FQSelect.SQL.Assign(FBaseSQLSelect);
4339	+	finally
4340	+	FQSelect.OnSQLChanged := SQLChanged;
4341	+	end;
4342	+	end;
4343	+	end;
4344	+
4345	+	function TIBCustomDataSet.HasParser: boolean;
4346	+	begin
4347	+	Result := not (csDesigning in ComponentState) and (FParser <> nil)
4348	+	end;
4349	+
4350	+	procedure TIBCustomDataSet.SetGenerateParamNames(AValue: Boolean);
4351	+	begin
4352	+	if FGenerateParamNames = AValue then Exit;
4353	+	FGenerateParamNames := AValue;
4354	+	Disconnect
4355	+	end;
4356	+
4357		procedure TIBCustomDataSet.InitRecord(Buffer: PChar);
4358		begin
4359		inherited InitRecord(Buffer);
#	Line 3788 | Line 4600 | end;
4600
4601		function TIBCustomDataSet.GetFieldData(Field: TField;
4602		Buffer: Pointer): Boolean;
4603	+	{$IFDEF TBCDFIELD_IS_BCD}
4604		var
4605		lTempCurr : System.Currency;
4606		begin
#	Line 3798 | Line 4611 | begin
4611		CurrToBCD(lTempCurr, TBCD(Buffer^), 32, Field.Size);
4612		end
4613		else
4614	+	{$ELSE}
4615	+	begin
4616	+	{$ENDIF}
4617		Result := InternalGetFieldData(Field, Buffer);
4618		end;
4619
#	Line 3811 | Line 4627 | begin
4627		end;
4628
4629		procedure TIBCustomDataSet.SetFieldData(Field: TField; Buffer: Pointer);
4630	+	{$IFDEF TDBDFIELD_IS_BCD}
4631		var
4632		lTempCurr : System.Currency;
4633		begin
#	Line 3820 | Line 4637 | begin
4637		InternalSetFieldData(Field, @lTempCurr);
4638		end
4639		else
4640	+	{$ELSE}
4641	+	begin
4642	+	{$ENDIF}
4643		InternalSetFieldData(Field, Buffer);
4644		end;
4645
#	Line 3851 | Line 4671 | begin
4671		FRefreshSQL.Assign(Value);
4672		end;
4673
4674	+	procedure TIBDataSetUpdateObject.InternalSetParams(Query: TIBSQL; buff: PChar);
4675	+	begin
4676	+	if not Assigned(DataSet) then Exit;
4677	+	DataSet.SetInternalSQLParams(Query, buff);
4678	+	end;
4679	+
4680		{ TIBDSBlobStream }
4681		constructor TIBDSBlobStream.Create(AField: TField; ABlobStream: TIBBlobStream;
4682		Mode: TBlobStreamMode);
#	Line 3862 | Line 4688 | begin
4688		FBlobStream.Truncate;
4689		end;
4690
4691	+	destructor TIBDSBlobStream.Destroy;
4692	+	begin
4693	+	if FHasWritten then
4694	+	TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
4695	+	inherited Destroy;
4696	+	end;
4697	+
4698		function TIBDSBlobStream.Read(var Buffer; Count: Longint): Longint;
4699		begin
4700		result := FBlobStream.Read(Buffer, Count);
#	Line 3884 | Line 4717 | begin
4717		TIBCustomDataSet(FField.DataSet).RecordModified(True);
4718		TBlobField(FField).Modified := true;
4719		result := FBlobStream.Write(Buffer, Count);
4720	<	TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, Longint(FField));
4720	>	FHasWritten := true;
4721	>	{  TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
4722	>	Removed as this caused a seek to beginning of the blob stream thus corrupting
4723	>	the blob stream. Moved to the destructor i.e. called after blob written}
4724		end;
4725
4726		{ TIBGenerator }
#	Line 3896 | Line 4732 | begin
4732		FIncrement := AValue
4733		end;
4734
3899	–	function TIBGenerator.GetSelectSQL: string;
3900	–	begin
3901	–	Result := FOwner.SelectSQL.Text
3902	–	end;
3903	–
4735		function TIBGenerator.GetNextValue(ADatabase: TIBDatabase;
4736		ATransaction: TIBTransaction): integer;
4737		begin
#	Line 3914 | Line 4745 | begin
4745		IBError(ibxeCannotSetTransaction,[]);
4746		with Transaction do
4747		if not InTransaction then StartTransaction;
4748	<	SQL.Text := Format('Select Gen_ID(%s,%d) as ID From RDB$Database',[GeneratorName,Increment]);
4748	>	SQL.Text := Format('Select Gen_ID(%s,%d) as ID From RDB$Database',[FGeneratorName,Increment]);
4749		Prepare;
4750		ExecQuery;
4751		try
#	Line 3936 | Line 4767 | end;
4767
4768		procedure TIBGenerator.Apply;
4769		begin
4770	<	if (GeneratorName <> '') and (FieldName <> '')  then
4771	<	Owner.FieldByName(FieldName).AsInteger := GetNextValue(Owner.Database,Owner.Transaction);
4770	>	if (FGeneratorName <> '') and (FFieldName <> '') and Owner.FieldByName(FFieldName).IsNull then
4771	>	Owner.FieldByName(FFieldName).AsInteger := GetNextValue(Owner.Database,Owner.Transaction);
4772		end;
4773
4774	+
4775		end.

Diff Legend

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