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 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	<	{$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 79 | 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 94 | 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 106 | 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 135 | 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 159 | Line 225 | type
225		FFieldName: string;
226		FGeneratorName: string;
227		FIncrement: integer;
162	–	function GetSelectSQL: string;
228		procedure SetIncrement(const AValue: integer);
229		protected
230		function GetNextValue(ADatabase: TIBDatabase; ATransaction: TIBTransaction): integer;
#	Line 167 | Line 232 | type
232		constructor Create(Owner: TIBCustomDataSet);
233		procedure Apply;
234		property Owner: TIBCustomDataSet read FOwner;
170	–	property SelectSQL: string read GetSelectSQL;
235		published
236	<	property GeneratorName: string read FGeneratorName write FGeneratorName;
237	<	property FieldName: string read FFieldName write FFieldName;
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	<	FGenerator: TIBGenerator;
275	>	FAutoCommit: TIBAutoCommit;
276	>	FGenerateParamNames: Boolean;
277	>	FGeneratorField: TIBGenerator;
278		FNeedsRefresh: Boolean;
279		FForcedRefresh: Boolean;
280		FDidActivate: Boolean;
#	Line 213 | Line 299 | type
299		FDeletedRecords: Long;
300		FModelBuffer,
301		FOldBuffer: PChar;
302	+	FOnValidatePost: TOnValidatePost;
303		FOpen: Boolean;
304		FInternalPrepared: Boolean;
305		FQDelete,
#	Line 223 | 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 240 | 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 253 | 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 273 | Line 368 | type
368		function GetModifySQL: TStrings;
369		function GetTransaction: TIBTransaction;
370		function GetTRHandle: PISC_TR_HANDLE;
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); 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 292 | Line 390 | type
390		procedure SetUpdateRecordTypes(Value: TIBUpdateRecordTypes);
391		procedure SetUniDirectional(Value: Boolean);
392		procedure RefreshParams;
295	–	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 311 | 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); virtual;
415		procedure InternalBatchOutput(OutputObject: TIBBatchOutput); virtual;
#	Line 320 | Line 419 | type
419		procedure InternalRefreshRow; virtual;
420		procedure InternalSetParamsFromCursor; virtual;
421		procedure CheckNotUniDirectional;
422	+	procedure SQLChanging(Sender: TObject); virtual;
423	+	procedure SQLChanged(Sender: TObject); virtual;
424
425		(*    { IProviderSupport }
426		procedure PSEndTransaction(Commit: Boolean); override;
#	Line 343 | 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;
#	Line 375 | Line 484 | type
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 387 | 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 402 | 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 Generator: TIBGenerator read FGenerator write FGenerator;
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 410 | 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 423 | 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 430 | 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 446 | Line 564 | type
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 497 | 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 522 | 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 532 | Line 661 | type
661		property RefreshSQL;
662		property SelectSQL;
663		property ModifySQL;
664	<	property Generator;
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 571 | 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 605 | 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 613 | Line 749 | DefaultFieldClasses: array[TFieldType] o
749		TBlobField,         { ftTypedBinary }
750		nil,                { ftCursor }
751		TStringField,       { ftFixedChar }
752	<	TWideStringField,    { ftWideString }
752	>	nil,    { ftWideString }
753		TLargeIntField,     { ftLargeInt }
754		nil,          { ftADT }
755		nil,        { ftArray }
#	Line 628 | Line 764 | DefaultFieldClasses: array[TFieldType] o
764		TDateTimeField,    {ftTimestamp}
765		TIBBCDField,       {ftFMTBcd}
766		nil,  {ftFixedWideChar}
767	<	TWideMemoField);   {ftWideMemo}
768	<
769	<	(*    TADTField,          { ftADT }
767	>	nil);   {ftWideMemo}
768	>	(*
769	>	TADTField,          { ftADT }
770		TArrayField,        { ftArray }
771		TReferenceField,    { ftReference }
772		TDataSetField,     { ftDataSet }
#	Line 639 | Line 775 | DefaultFieldClasses: array[TFieldType] o
775		TVariantField,      { ftVariant }
776		TInterfaceField,    { ftInterface }
777		TIDispatchField,     { ftIDispatch }
778	<	TGuidField);        { ftGuid }*)
778	>	TGuidField);        { ftGuid } *)
779		(*var
780		CreateProviderProc: function(DataSet: TIBCustomDataSet): IProvider = nil;*)
781
782		implementation
783
784	<	uses IBIntf, Variants, FmtBCD;
784	>	uses IBIntf, Variants, FmtBCD, LazUTF8, IBCodePage;
785
786		const FILE_BEGIN = 0;
787		FILE_CURRENT = 1;
#	Line 668 | Line 804 | type
804		NextRelation : TRelationNode;
805		end;
806
807	+	{Extended Field Def for character set info}
808
809	<	{ TIBStringField}
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 TIBStringField.Create(AOwner: TComponent);
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	+	function TIBStringField.GetDefaultWidth: Longint;
982	+	begin
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 696 | 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 703 | 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 715 | 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 728 | Line 1064 | begin
1064		end;
1065		end;
1066
1067	+
1068		{ TIBBCDField }
1069
1070		constructor TIBBCDField.Create(AOwner: TComponent);
#	Line 770 | 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 821 | Line 1162 | begin
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	<	FGenerator := TIBGenerator.Create(self);
1171	>	FGeneratorField := TIBGenerator.Create(self);
1172		FDataLink := TIBDataLink.Create(Self);
1173		FQDelete := TIBSQL.Create(Self);
1174		FQDelete.OnSQLChanging := SQLChanging;
#	Line 839 | 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 859 | 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	+	if Active then Active := false;
1214		if FIBLoaded then
1215		begin
1216	<	if assigned(FGenerator) then FGenerator.Free;
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 878 | 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
#	Line 919 | 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 979 | 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 1117 | 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 1177 | 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 1280 | 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 1321 | 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;
1327	–	temp: TIBXSQLVAR;
1718		begin
1719		p := PRecordData(Buffer);
1720		{ Make sure blob cache is empty }
#	Line 1373 | 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 1453 | 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	<	begin
1462	<	temp :=  Qry.Current[i];
1463	<	LocalData := @temp.Data^.sqldata[2];
1464	<	(*              LocalData := @Qry.Current[i].Data^.sqldata[2];*)
1465	<	end;
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;
1471	–	if (rdFields[j].fdDataType = SQL_TEXT) then
1472	–	rdFields[j].fdDataLength := rdFields[j].fdDataSize;
1881		end;
1882		end;
1883		if RecordNumber < 0 then
#	Line 1589 | 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 1606 | 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;
1623	<	result := True;
1624	<	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));
1636	<	except
1637	<	on E: EVariantError do result := False;
1638	<	end;
1639	<	if Result then
1640	<	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);
1645	<	val := AnsiUpperCase(val);
1646	<	end;
1647	<	fld := TrimRight(fld);
1648	<	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 1691 | 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 1712 | Line 2144 | end;
2144		procedure TIBCustomDataSet.InternalRefreshRow;
2145		var
2146		Buff: PChar;
1715	–	SetCursor: Boolean;
2147		ofs: DWORD;
2148		Qry: TIBSQL;
2149		begin
2150	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1720	<	if SetCursor then
1721	<	Screen.Cursor := crHourGlass;
2150	>	FBase.SetCursor;
2151		try
2152		Buff := GetActiveBuf;
2153		if CanRefresh then
#	Line 1762 | Line 2191 | begin
2191		else
2192		IBError(ibxeCannotRefresh, [nil]);
2193		finally
2194	<	if SetCursor and (Screen.Cursor = crHourGlass) then
1766	<	Screen.Cursor := crDefault;
2194	>	FBase.RestoreCursor;
2195		end;
2196		end;
2197
#	Line 1834 | Line 2262 | end;
2262
2263		procedure TIBCustomDataSet.InternalPrepare;
2264		var
1837	–	SetCursor: Boolean;
2265		DidActivate: Boolean;
2266		begin
2267		if FInternalPrepared then
2268		Exit;
2269		DidActivate := False;
2270	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1844	<	if SetCursor then
1845	<	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 1870 | Line 2310 | begin
2310		finally
2311		if DidActivate then
2312		DeactivateTransaction;
2313	<	if SetCursor and (Screen.Cursor = crHourGlass) then
1874	<	Screen.Cursor := crDefault;
2313	>	FBase.RestoreCursor;
2314		end;
2315		end;
2316
#	Line 1973 | 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 2021 | 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 2061 | 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 2148 | 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 2183 | 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 2199 | 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 2237 | 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 2274 | 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 2396 | Line 2875 | begin
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;
2886		var
2887		Buff: PRecordData;
#	Line 2410 | Line 2896 | begin
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
#	Line 2419 | Line 2911 | end;
2911
2912		procedure TIBCustomDataSet.DoAfterInsert;
2913		begin
2914	<	if Generator.ApplyOnEvent = gaeOnNewRecord then
2915	<	Generator.Apply;
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	<	(Generator.ApplyOnEvent = gaeOnPostRecord) then
2952	<	Generator.Apply
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
2442	<	Screen.Cursor := crHourGlass;
2443	<	try
2970	>	FBase.SetCursor;
2971	>	try
2972		if FQSelect.EOF or not FQSelect.Open then
2973		exit;
2974		DisableControls;
#	Line 2452 | Line 2980 | begin
2980		EnableControls;
2981		end;
2982		finally
2983	<	if SetCursor and (Screen.Cursor = crHourGlass) then
2456	<	Screen.Cursor := crDefault;
2983	>	FBase.RestoreCursor;
2984		end;
2985		end;
2986
#	Line 2501 | 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 2519 | 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 2541 | 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 2585 | 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 2679 | 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 2750 | 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;
2759	–	SetCursor: Boolean;
3320		begin
3321	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
2762	<	if SetCursor then
2763	<	Screen.Cursor := crHourGlass;
3321	>	FBase.SetCursor;
3322		try
3323		Buff := GetActiveBuf;
3324		if CanDelete then
#	Line 2785 | Line 3343 | begin
3343		end else
3344		IBError(ibxeCannotDelete, [nil]);
3345		finally
3346	<	if SetCursor and (Screen.Cursor = crHourGlass) then
2789	<	Screen.Cursor := crDefault;
3346	>	FBase.RestoreCursor;
3347		end;
3348		end;
3349
#	Line 2802 | 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 2817 | 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 2919 | Line 3492 | var
3492		end;
3493
3494		begin
2922	–	if not InternalPrepared then
2923	–	begin
2924	–	InternalPrepare;
2925	–	exit;
2926	–	end;
3495		FRelationNodes := TRelationNode.Create;
3496		FNeedsRefresh := False;
3497		Database.InternalTransaction.StartTransaction;
#	Line 2934 | 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 2980 | 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 2993 | 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 3002 | 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 3011 | 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 3019 | 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;*)
3026	<	DataType := FieldType;
3628	>	Name := FieldAliasName;
3629	>	FAliasNameMap[FieldNo-1] := DBAliasName;
3630		Size := FieldSize;
3631		Precision := FieldPrecision;
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 3107 | 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 3160 | Line 3770 | begin
3770		end;
3771
3772		procedure TIBCustomDataSet.InternalOpen;
3163	–	var
3164	–	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);
3173	<	if SetCursor then
3174	<	Screen.Cursor := crHourGlass;
3829	>	FBase.SetCursor;
3830		try
3831		ActivateConnection;
3832		ActivateTransaction;
#	Line 3184 | 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 3232 | Line 3888 | begin
3888		else
3889		FQSelect.ExecQuery;
3890		finally
3891	<	if SetCursor and (Screen.Cursor = crHourGlass) then
3236	<	Screen.Cursor := crDefault;
3891	>	FBase.RestoreCursor;
3892		end;
3893		end;
3894
#	Line 3241 | Line 3896 | procedure TIBCustomDataSet.InternalPost;
3896		var
3897		Qry: TIBSQL;
3898		Buff: PChar;
3244	–	SetCursor: Boolean;
3899		bInserting: Boolean;
3900		begin
3901	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3248	<	if SetCursor then
3249	<	Screen.Cursor := crHourGlass;
3901	>	FBase.SetCursor;
3902		try
3903		Buff := GetActiveBuf;
3904		CheckEditState;
#	Line 3284 | Line 3936 | begin
3936		if bInserting then
3937		Inc(FRecordCount);
3938		finally
3939	<	if SetCursor and (Screen.Cursor = crHourGlass) then
3288	<	Screen.Cursor := crDefault;
3939	>	FBase.RestoreCursor;
3940		end;
3941		end;
3942
#	Line 3305 | 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 3326 | 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 3379 | 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 3395 | 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 3432 | 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 3496 | 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 3503 | 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;
3513	–	SetCursor: Boolean;
4202		begin
4203		DidActivate := False;
4204	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3517	<	if SetCursor then
3518	<	Screen.Cursor := crHourGlass;
4204	>	FBase.SetCursor;
4205		try
4206		ActivateConnection;
4207		DidActivate := ActivateTransaction;
#	Line 3532 | Line 4218 | begin
4218		finally
4219		if DidActivate then
4220		DeactivateTransaction;
4221	<	if SetCursor and (Screen.Cursor = crHourGlass) then
3536	<	Screen.Cursor := crDefault;
4221	>	FBase.RestoreCursor;
4222		end;
4223		end;
4224
#	Line 3542 | 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 3788 | 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 3798 | 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 3811 | 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
#	Line 3820 | Line 4544 | begin
4544		InternalSetFieldData(Field, @lTempCurr);
4545		end
4546		else
4547	+	{$ELSE}
4548	+	begin
4549	+	{$ENDIF}
4550		InternalSetFieldData(Field, Buffer);
4551		end;
4552
#	Line 3851 | 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 3859 | 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 3884 | Line 4634 | begin
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 }
#	Line 3896 | Line 4649 | begin
4649		FIncrement := AValue
4650		end;
4651
3899	–	function TIBGenerator.GetSelectSQL: string;
3900	–	begin
3901	–	Result := FOwner.SelectSQL.Text
3902	–	end;
3903	–
4652		function TIBGenerator.GetNextValue(ADatabase: TIBDatabase;
4653		ATransaction: TIBTransaction): integer;
4654		begin
#	Line 3914 | Line 4662 | begin
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',[GeneratorName,Increment]);
4665	>	SQL.Text := Format('Select Gen_ID(%s,%d) as ID From RDB$Database',[FGeneratorName,Increment]);
4666		Prepare;
4667		ExecQuery;
4668		try
#	Line 3936 | Line 4684 | end;
4684
4685		procedure TIBGenerator.Apply;
4686		begin
4687	<	if (GeneratorName <> '') and (FieldName <> '')  then
4688	<	Owner.FieldByName(FieldName).AsInteger := GetNextValue(Owner.Database,Owner.Transaction);
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