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 7 by tony, Sun Aug 5 18:28:19 2012 UTC vs.
Revision 35 by tony, Tue Jan 26 14:38:47 2016 UTC

#	Line 27 | Line 27
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                                                 }
30	>	{    Associates Ltd 2011 - 2015                                                }
31		{                                                                        }
32		{************************************************************************}
33
34		unit IBCustomDataSet;
35
36	+	{$R-}
37	+
38		{$Mode Delphi}
39
40		{$IFDEF DELPHI}
#	Line 47 | Line 49 | uses
49		{$ELSE}
50		unix,
51		{$ENDIF}
52	<	SysUtils, Classes, Forms, Controls, IBDatabase,
53	<	IBExternals, IB, IBHeader,  IBSQL, Db,
52	<	IBUtils, IBBlob;
52	>	SysUtils, Classes, IBDatabase, IBExternals, IB, IBHeader,  IBSQL, Db,
53	>	IBUtils, IBBlob, IBSQLParser;
54
55		const
56		BufferCacheSize    =  1000;  { Allocate cache in this many record chunks}
#	Line 118 | Line 119 | type
119		{ TIBStringField allows us to have strings longer than 8196 }
120
121		TIBStringField = class(TStringField)
122	+	private
123	+	FCharacterSetName: string;
124	+	FCharacterSetSize: integer;
125	+	protected
126	+	function GetDefaultWidth: Longint; override;
127		public
128	<	constructor create(AOwner: TComponent); override;
128	>	constructor Create(aOwner: TComponent); override;
129		class procedure CheckTypeSize(Value: Integer); override;
130		function GetAsString: string; override;
131		function GetAsVariant: Variant; override;
132		function GetValue(var Value: string): Boolean;
133		procedure SetAsString(const Value: string); override;
134	+	property CharacterSetName: string read FCharacterSetName write FCharacterSetName;
135	+	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
136	+	end;
137	+
138	+	{ TIBWideStringField }
139	+
140	+	TIBWideStringField = class(TWideStringField)
141	+	private
142	+	FCharacterSetName: string;
143	+	FCharacterSetSize: integer;
144	+	public
145	+	property CharacterSetName: string read FCharacterSetName write FCharacterSetName;
146	+	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
147		end;
148
149		{ TIBBCDField }
#	Line 147 | Line 166 | type
166		property Size default 8;
167		end;
168
169	+	{TIBMemoField}
170	+	{Allows us to show truncated text in DBGrids and anything else that uses
171	+	DisplayText}
172	+
173	+	TIBMemoField = class(TMemoField)
174	+	private
175	+	FCharacterSetName: string;
176	+	FCharacterSetSize: integer;
177	+	FDisplayTextAsClassName: boolean;
178	+	function GetTruncatedText: string;
179	+	protected
180	+	function GetDefaultWidth: Longint; override;
181	+	procedure GetText(var AText: string; ADisplayText: Boolean); override;
182	+	public
183	+	constructor Create(AOwner: TComponent); override;
184	+	property CharacterSetName: string read FCharacterSetName write FCharacterSetName;
185	+	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
186	+	published
187	+	property DisplayTextAsClassName: boolean read FDisplayTextAsClassName
188	+	write FDisplayTextAsClassName;
189	+	end;
190	+
191	+	{ TIBWideMemoField }
192	+
193	+	TIBWideMemoField = class(TWideMemoField)
194	+	private
195	+	FCharacterSetName: string;
196	+	FCharacterSetSize: integer;
197	+	FDisplayTextAsClassName: boolean;
198	+	function GetTruncatedText: string;
199	+	protected
200	+	function GetDefaultWidth: Longint; override;
201	+	procedure GetText(var AText: string; ADisplayText: Boolean); override;
202	+	public
203	+	constructor Create(AOwner: TComponent); override;
204	+	property CharacterSetName: string read FCharacterSetName write FCharacterSetName;
205	+	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
206	+	published
207	+	property DisplayTextAsClassName: boolean read FDisplayTextAsClassName
208	+	write FDisplayTextAsClassName;
209	+	end;
210	+
211		TIBDataLink = class(TDetailDataLink)
212		private
213		FDataSet: TIBCustomDataSet;
#	Line 185 | Line 246 | type
246		property ApplyOnEvent: TIBGeneratorApplyOnEvent read FApplyOnEvent write FApplyOnEvent;
247		end;
248
249	+	{TIBControlLink - Allows IB Aware controls to react to dataset state changes}
250	+
251	+	TIBControlLink = class
252	+	private
253	+	FTIBDataSet: TIBCustomDataSet;
254	+	procedure SetIBDataSet(AValue: TIBCustomDataSet);
255	+	protected
256	+	procedure UpdateSQL(Sender: TObject); virtual;
257	+	procedure UpdateParams(Sender: TObject); virtual;
258	+	public
259	+	destructor Destroy; override;
260	+	property IBDataSet: TIBCustomDataSet read FTIBDataSet write SetIBDataSet;
261	+	end;
262	+
263	+	TIBAutoCommit = (acDisabled, acCommitRetaining);
264	+
265		{ TIBCustomDataSet }
266		TIBUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApply, uaApplied);
267
268		TIBUpdateErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
269	<	UpdateKind: TUpdateKind; var UpdateAction: TIBUpdateAction)
269	>	UpdateKind: TUpdateKind; var TheUpdateAction: TIBUpdateAction)
270		of object;
271		TIBUpdateRecordEvent = procedure(DataSet: TDataSet; UpdateKind: TUpdateKind;
272		var UpdateAction: TIBUpdateAction) of object;
273
274		TIBUpdateRecordTypes = set of TCachedUpdateStatus;
275
276	+	TDataSetCloseAction = (dcDiscardChanges, dcSaveChanges);
277	+
278	+	TOnValidatePost = procedure (Sender: TObject; var CancelPost: boolean) of object;
279	+
280		TIBCustomDataSet = class(TDataset)
281		private
282	+	FAutoCommit: TIBAutoCommit;
283	+	FGenerateParamNames: Boolean;
284		FGeneratorField: TIBGenerator;
285		FNeedsRefresh: Boolean;
286		FForcedRefresh: Boolean;
#	Line 223 | Line 306 | type
306		FDeletedRecords: Long;
307		FModelBuffer,
308		FOldBuffer: PChar;
309	+	FOnValidatePost: TOnValidatePost;
310		FOpen: Boolean;
311		FInternalPrepared: Boolean;
312		FQDelete,
#	Line 233 | Line 317 | type
317		FRecordBufferSize: Integer;
318		FRecordCount: Integer;
319		FRecordSize: Integer;
320	+	FDataSetCloseAction: TDataSetCloseAction;
321		FUniDirectional: Boolean;
322		FUpdateMode: TUpdateMode;
323		FUpdateObject: TIBDataSetUpdateObject;
#	Line 250 | Line 335 | type
335		FBeforeTransactionEnd,
336		FAfterTransactionEnd,
337		FTransactionFree: TNotifyEvent;
338	<
338	>	FAliasNameMap: array of string;
339	>	FAliasNameList: array of string;
340	>	FBaseSQLSelect: TStrings;
341	>	FParser: TSelectSQLParser;
342	>	FCloseAction: TTransactionAction;
343	>	FInTransactionEnd: boolean;
344	>	FIBLinks: TList;
345		function GetSelectStmtHandle: TISC_STMT_HANDLE;
346		procedure SetUpdateMode(const Value: TUpdateMode);
347		procedure SetUpdateObject(Value: TIBDataSetUpdateObject);
#	Line 263 | Line 354 | type
354		function CanRefresh: Boolean;
355		procedure CheckEditState;
356		procedure ClearBlobCache;
357	+	procedure ClearIBLinks;
358		procedure CopyRecordBuffer(Source, Dest: Pointer);
359		procedure DoBeforeDatabaseDisconnect(Sender: TObject);
360		procedure DoAfterDatabaseDisconnect(Sender: TObject);
361		procedure DoDatabaseFree(Sender: TObject);
362	<	procedure DoBeforeTransactionEnd(Sender: TObject);
362	>	procedure DoBeforeTransactionEnd(Sender: TObject; Action: TTransactionAction);
363		procedure DoAfterTransactionEnd(Sender: TObject);
364		procedure DoTransactionFree(Sender: TObject);
365		procedure FetchCurrentRecordToBuffer(Qry: TIBSQL; RecordNumber: Integer;
#	Line 283 | Line 375 | type
375		function GetModifySQL: TStrings;
376		function GetTransaction: TIBTransaction;
377		function GetTRHandle: PISC_TR_HANDLE;
378	+	function GetParser: TSelectSQLParser;
379		procedure InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer); virtual;
380		function InternalLocate(const KeyFields: string; const KeyValues: Variant;
381		Options: TLocateOptions): Boolean; virtual;
382		procedure InternalPostRecord(Qry: TIBSQL; Buff: Pointer); virtual;
383		procedure InternalRevertRecord(RecordNumber: Integer); virtual;
384		function IsVisible(Buffer: PChar): Boolean;
385	+	procedure RegisterIBLink(Sender: TIBControlLink);
386	+	procedure UnRegisterIBLink(Sender: TIBControlLink);
387		procedure SaveOldBuffer(Buffer: PChar);
388		procedure SetBufferChunks(Value: Integer);
389		procedure SetDatabase(Value: TIBDatabase);
#	Line 302 | Line 397 | type
397		procedure SetUpdateRecordTypes(Value: TIBUpdateRecordTypes);
398		procedure SetUniDirectional(Value: Boolean);
399		procedure RefreshParams;
305	–	procedure SQLChanging(Sender: TObject); virtual;
400		function AdjustPosition(FCache: PChar; Offset: DWORD;
401		Origin: Integer): DWORD;
402		procedure ReadCache(FCache: PChar; Offset: DWORD; Origin: Integer;
#	Line 321 | Line 415 | type
415		procedure DeactivateTransaction;
416		procedure CheckDatasetClosed;
417		procedure CheckDatasetOpen;
418	+	function CreateParser: TSelectSQLParser; virtual;
419	+	procedure FieldDefsFromQuery(SourceQuery: TIBSQL);
420		function GetActiveBuf: PChar;
421		procedure InternalBatchInput(InputObject: TIBBatchInput); virtual;
422		procedure InternalBatchOutput(OutputObject: TIBBatchOutput); virtual;
#	Line 330 | Line 426 | type
426		procedure InternalRefreshRow; virtual;
427		procedure InternalSetParamsFromCursor; virtual;
428		procedure CheckNotUniDirectional;
429	+	procedure SQLChanging(Sender: TObject); virtual;
430	+	procedure SQLChanged(Sender: TObject); virtual;
431
432		(*    { IProviderSupport }
433		procedure PSEndTransaction(Commit: Boolean); override;
#	Line 353 | Line 451 | type
451		procedure ClearCalcFields(Buffer: PChar); override;
452		function AllocRecordBuffer: PChar; override;
453		procedure DoBeforeDelete; override;
454	+	procedure DoAfterDelete; override;
455		procedure DoBeforeEdit; override;
456	+	procedure DoAfterEdit; override;
457		procedure DoBeforeInsert; override;
458		procedure DoAfterInsert; override;
459	+	procedure DoBeforeClose; override;
460	+	procedure DoBeforeOpen; override;
461		procedure DoBeforePost; override;
462	+	procedure DoAfterPost; override;
463		procedure FreeRecordBuffer(var Buffer: PChar); override;
464		procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
465		function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
466		function GetCanModify: Boolean; override;
467		function GetDataSource: TDataSource; override;
468	+	function GetDBAliasName(FieldNo: integer): string;
469	+	function GetFieldDefFromAlias(aliasName: string): TFieldDef;
470		function GetFieldClass(FieldType: TFieldType): TFieldClass; override;
471		function GetRecNo: Integer; override;
472		function GetRecord(Buffer: PChar; GetMode: TGetMode;
473		DoCheck: Boolean): TGetResult; override;
474		function GetRecordCount: Integer; override;
475		function GetRecordSize: Word; override;
476	+	procedure InternalAutoCommit;
477		procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override;
478		procedure InternalCancel; override;
479		procedure InternalClose; override;
#	Line 385 | Line 491 | type
491		procedure InternalSetFieldData(Field: TField; Buffer: Pointer); virtual;
492		procedure InternalSetToRecord(Buffer: PChar); override;
493		function IsCursorOpen: Boolean; override;
494	+	procedure Loaded; override;
495		procedure ReQuery;
496		procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
497		procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
498		procedure SetCachedUpdates(Value: Boolean);
499		procedure SetDataSource(Value: TDataSource);
500	+	procedure SetGenerateParamNames(AValue: Boolean); virtual;
501		procedure SetFieldData(Field : TField; Buffer : Pointer); override;
502		procedure SetFieldData(Field : TField; Buffer : Pointer;
503		NativeFormat : Boolean); overload; override;
#	Line 397 | Line 505 | type
505
506		protected
507		{Likely to be made public by descendant classes}
508	+	property AutoCommit: TIBAutoCommit read FAutoCommit write FAutoCommit default acDisabled;
509		property SQLParams: TIBXSQLDA read GetSQLParams;
510		property Params: TIBXSQLDA read GetSQLParams;
511		property InternalPrepared: Boolean read FInternalPrepared;
#	Line 420 | Line 529 | type
529		property ModifySQL: TStrings read GetModifySQL write SetModifySQL;
530		property UpdateMode: TUpdateMode read FUpdateMode write SetUpdateMode default upWhereAll;
531		property ParamCheck: Boolean read FParamCheck write FParamCheck default True;
532	+	property Parser: TSelectSQLParser read GetParser;
533	+	property BaseSQLSelect: TStrings read FBaseSQLSelect;
534
535		property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect
536		write FBeforeDatabaseDisconnect;
#	Line 433 | Line 544 | type
544		write FAfterTransactionEnd;
545		property TransactionFree: TNotifyEvent read FTransactionFree
546		write FTransactionFree;
547	+	property OnValidatePost: TOnValidatePost read FOnValidatePost write FOnValidatePost;
548
549		public
550		constructor Create(AOwner: TComponent); override;
#	Line 440 | Line 552 | type
552		procedure ApplyUpdates;
553		function CachedUpdateStatus: TCachedUpdateStatus;
554		procedure CancelUpdates;
555	+	function GetFieldPosition(AliasName: string): integer;
556		procedure FetchAll;
557		function LocateNext(const KeyFields: string; const KeyValues: Variant;
558		Options: TLocateOptions): Boolean;
559		procedure RecordModified(Value: Boolean);
560		procedure RevertRecord;
561		procedure Undelete;
562	+	procedure ResetParser; virtual;
563	+	function HasParser: boolean;
564
565		{ TDataSet support methods }
566		function BookmarkValid(Bookmark: TBookmark): Boolean; override;
#	Line 456 | Line 571 | type
571		function GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; overload; (*override;*)
572		function GetFieldData(Field : TField; Buffer : Pointer;
573		NativeFormat : Boolean) : Boolean; overload; override;
574	+	property GenerateParamNames: Boolean read FGenerateParamNames write SetGenerateParamNames;
575		function Locate(const KeyFields: string; const KeyValues: Variant;
576		Options: TLocateOptions): Boolean; override;
577		function Lookup(const KeyFields: string; const KeyValues: Variant;
578		const ResultFields: string): Variant; override;
579		function UpdateStatus: TUpdateStatus; override;
580		function IsSequenced: Boolean; override;
581	+	procedure Post; override;
582		function ParamByName(ParamName: String): TIBXSQLVAR;
583		property DBHandle: PISC_DB_HANDLE read GetDBHandle;
584		property TRHandle: PISC_TR_HANDLE read GetTRHandle;
#	Line 469 | Line 586 | type
586		property UpdatesPending: Boolean read FUpdatesPending;
587		property UpdateRecordTypes: TIBUpdateRecordTypes read FUpdateRecordTypes
588		write SetUpdateRecordTypes;
589	+	property DataSetCloseAction: TDataSetCloseAction
590	+	read FDataSetCloseAction write FDataSetCloseAction;
591
592		published
593		property Database: TIBDatabase read GetDatabase write SetDatabase;
#	Line 507 | Line 626 | type
626		write FOnUpdateRecord;
627		end;
628
629	<	TIBDataSet = class(TIBCustomDataSet)
629	>	TIBParserDataSet = class(TIBCustomDataSet)
630	>	public
631	>	property Parser;
632	>	end;
633	>
634	>	TIBDataSet = class(TIBParserDataSet)
635		private
636		function GetPrepared: Boolean;
637
#	Line 532 | Line 656 | type
656		property QModify;
657		property StatementType;
658		property SelectStmtHandle;
659	+	property BaseSQLSelect;
660
661		published
662		{ TIBCustomDataSet }
663	+	property AutoCommit;
664		property BufferChunks;
665		property CachedUpdates;
666		property DeleteSQL;
#	Line 543 | Line 669 | type
669		property SelectSQL;
670		property ModifySQL;
671		property GeneratorField;
672	+	property GenerateParamNames;
673		property ParamCheck;
674		property UniDirectional;
675		property Filtered;
676	+	property DataSetCloseAction;
677
678		property BeforeDatabaseDisconnect;
679		property AfterDatabaseDisconnect;
#	Line 581 | Line 709 | type
709		property OnFilterRecord;
710		property OnNewRecord;
711		property OnPostError;
712	+	property OnValidatePost;
713		end;
714
715		{ TIBDSBlobStream }
716		TIBDSBlobStream = class(TStream)
717	+	private
718	+	FHasWritten: boolean;
719		protected
720		FField: TField;
721		FBlobStream: TIBBlobStream;
722		public
723		constructor Create(AField: TField; ABlobStream: TIBBlobStream;
724		Mode: TBlobStreamMode);
725	+	destructor Destroy; override;
726		function Read(var Buffer; Count: Longint): Longint; override;
727		function Seek(Offset: Longint; Origin: Word): Longint; override;
728		procedure SetSize(NewSize: Longint); override;
#	Line 615 | Line 747 | DefaultFieldClasses: array[TFieldType] o
747		TVarBytesField,     { ftVarBytes }
748		TAutoIncField,      { ftAutoInc }
749		TBlobField,         { ftBlob }
750	<	TMemoField,         { ftMemo }
750	>	TIBMemoField,       { ftMemo }
751		TGraphicField,      { ftGraphic }
752		TBlobField,         { ftFmtMemo }
753		TBlobField,         { ftParadoxOle }
#	Line 623 | Line 755 | DefaultFieldClasses: array[TFieldType] o
755		TBlobField,         { ftTypedBinary }
756		nil,                { ftCursor }
757		TStringField,       { ftFixedChar }
758	<	TWideStringField,    { ftWideString }
758	>	TIBWideStringField,    { ftWideString }
759		TLargeIntField,     { ftLargeInt }
760		nil,          { ftADT }
761		nil,        { ftArray }
#	Line 638 | Line 770 | DefaultFieldClasses: array[TFieldType] o
770		TDateTimeField,    {ftTimestamp}
771		TIBBCDField,       {ftFMTBcd}
772		nil,  {ftFixedWideChar}
773	<	TWideMemoField);   {ftWideMemo}
773	>	TIBWideMemoField);   {ftWideMemo}
774		(*
775		TADTField,          { ftADT }
776		TArrayField,        { ftArray }
#	Line 655 | Line 787 | DefaultFieldClasses: array[TFieldType] o
787
788		implementation
789
790	<	uses IBIntf, Variants, FmtBCD;
790	>	uses IBIntf, Variants, FmtBCD, LCLProc, LazUTF8;
791
792		const FILE_BEGIN = 0;
793		FILE_CURRENT = 1;
#	Line 678 | Line 810 | type
810		NextRelation : TRelationNode;
811		end;
812
813	+	{Extended Field Def for character set info}
814
815	<	{ TIBStringField}
815	>	{ TIBFieldDef }
816	>
817	>	TIBFieldDef = class(TFieldDef)
818	>	private
819	>	FCharacterSetName: string;
820	>	FCharacterSetSize: integer;
821	>	published
822	>	property CharacterSetName: string read FCharacterSetName write FCharacterSetName;
823	>	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
824	>	end;
825	>
826	>	{ TIBWideMemoField }
827	>
828	>	function TIBWideMemoField.GetTruncatedText: string;
829	>	begin
830	>	Result := GetAsString;
831	>
832	>	if Result <> '' then
833	>	if DisplayWidth = 0 then
834	>	Result := TextToSingleLine(Result)
835	>	else
836	>	if Length(Result) > DisplayWidth then {Show truncation with elipses}
837	>	Result := TextToSingleLine(system.copy(Result,1,DisplayWidth-3)) + '...';
838	>	end;
839
840	<	constructor TIBStringField.Create(AOwner: TComponent);
840	>	function TIBWideMemoField.GetDefaultWidth: Longint;
841	>	begin
842	>	Result := 128;
843	>	end;
844	>
845	>	procedure TIBWideMemoField.GetText(var AText: string; ADisplayText: Boolean);
846	>	begin
847	>	if ADisplayText then
848	>	begin
849	>	if not DisplayTextAsClassName then
850	>	AText := GetTruncatedText
851	>	else
852	>	inherited GetText(AText, ADisplayText);
853	>	end
854	>	else
855	>	AText := GetAsString;
856	>	end;
857	>
858	>	constructor TIBWideMemoField.Create(AOwner: TComponent);
859		begin
860		inherited Create(AOwner);
861	+	BlobType := ftWideMemo;
862	+	end;
863	+
864	+	{ TIBMemoField }
865	+
866	+	function TIBMemoField.GetTruncatedText: string;
867	+	begin
868	+	Result := GetAsString;
869	+
870	+	if Result <> '' then
871	+	begin
872	+	case CharacterSetSize of
873	+	1:
874	+	if DisplayWidth = 0 then
875	+	Result := TextToSingleLine(Result)
876	+	else
877	+	if Length(Result) > DisplayWidth then {Show truncation with elipses}
878	+	Result := TextToSingleLine(system.copy(Result,1,DisplayWidth-3)) + '...';
879	+
880	+	{2: case 2 ignored. This should be handled by TIBWideMemo}
881	+
882	+	3, {Assume UNICODE_FSS is really UTF8}
883	+	4: {Include GB18030 - assuming UTF8 routine work for this codeset}
884	+	if DisplayWidth = 0 then
885	+	Result := ValidUTF8String(TextToSingleLine(Result))
886	+	else
887	+	if UTF8Length(Result) > DisplayWidth then {Show truncation with elipses}
888	+	Result := ValidUTF8String(TextToSingleLine(UTF8Copy(Result,1,DisplayWidth-3))) + '...';
889	+	end;
890	+	end
891	+	end;
892	+
893	+	function TIBMemoField.GetDefaultWidth: Longint;
894	+	begin
895	+	Result := 128;
896	+	end;
897	+
898	+	procedure TIBMemoField.GetText(var AText: string; ADisplayText: Boolean);
899	+	begin
900	+	if ADisplayText then
901	+	begin
902	+	if not DisplayTextAsClassName then
903	+	AText := GetTruncatedText
904	+	else
905	+	inherited GetText(AText, ADisplayText);
906	+	end
907	+	else
908	+	AText := GetAsString;
909	+	end;
910	+
911	+	constructor TIBMemoField.Create(AOwner: TComponent);
912	+	begin
913	+	inherited Create(AOwner);
914	+	BlobType := ftMemo;
915	+	end;
916	+
917	+	{ TIBControlLink }
918	+
919	+	destructor TIBControlLink.Destroy;
920	+	begin
921	+	IBDataSet := nil;
922	+	inherited Destroy;
923	+	end;
924	+
925	+	procedure TIBControlLink.UpdateParams(Sender: TObject);
926	+	begin
927	+
928	+	end;
929	+
930	+	procedure TIBControlLink.UpdateSQL(Sender: TObject);
931	+	begin
932	+
933	+	end;
934	+
935	+	procedure TIBControlLink.SetIBDataSet(AValue: TIBCustomDataSet);
936	+	begin
937	+	if FTIBDataSet = AValue then Exit;
938	+	if IBDataSet <> nil then
939	+	IBDataSet.UnRegisterIBLink(self);
940	+	FTIBDataSet := AValue;
941	+	if IBDataSet <> nil then
942	+	IBDataSet.RegisterIBLink(self);
943	+	end;
944	+
945	+
946	+	{ TIBStringField}
947	+
948	+	function TIBStringField.GetDefaultWidth: Longint;
949	+	begin
950	+	Result := Size div CharacterSetSize;
951	+	end;
952	+
953	+	constructor TIBStringField.Create(aOwner: TComponent);
954	+	begin
955	+	inherited Create(aOwner);
956	+	FCharacterSetSize := 1;
957		end;
958
959		class procedure TIBStringField.CheckTypeSize(Value: Integer);
#	Line 738 | Line 1008 | begin
1008		end;
1009		end;
1010
1011	+
1012		{ TIBBCDField }
1013
1014		constructor TIBBCDField.Create(AOwner: TComponent);
#	Line 835 | Line 1106 | begin
1106		CheckIBLoaded;
1107		FIBLoaded := True;
1108		FBase := TIBBase.Create(Self);
1109	+	FIBLinks := TList.Create;
1110		FCurrentRecord := -1;
1111		FDeletedRecords := 0;
1112		FUniDirectional := False;
#	Line 853 | Line 1125 | begin
1125		FQRefresh.GoToFirstRecordOnExecute := False;
1126		FQSelect := TIBSQL.Create(Self);
1127		FQSelect.OnSQLChanging := SQLChanging;
1128	+	FQSelect.OnSQLChanged := SQLChanged;
1129		FQSelect.GoToFirstRecordOnExecute := False;
1130		FQModify := TIBSQL.Create(Self);
1131		FQModify.OnSQLChanging := SQLChanging;
1132		FQModify.GoToFirstRecordOnExecute := False;
1133		FUpdateRecordTypes := [cusUnmodified, cusModified, cusInserted];
1134		FParamCheck := True;
1135	+	FGenerateParamNames := False;
1136		FForcedRefresh := False;
1137	+	FAutoCommit:= acDisabled;
1138	+	FDataSetCloseAction := dcDiscardChanges;
1139		{Bookmark Size is Integer for IBX}
1140		BookmarkSize := SizeOf(Integer);
1141		FBase.BeforeDatabaseDisconnect := DoBeforeDatabaseDisconnect;
#	Line 873 | Line 1149 | begin
1149		else
1150		if AOwner is TIBTransaction then
1151		Transaction := TIBTransaction(AOwner);
1152	+	FBaseSQLSelect := TStringList.Create;
1153		end;
1154
1155		destructor TIBCustomDataSet.Destroy;
#	Line 884 | Line 1161 | begin
1161		FDataLink.Free;
1162		FBase.Free;
1163		ClearBlobCache;
1164	+	ClearIBLinks;
1165	+	FIBLinks.Free;
1166		FBlobStreamList.Free;
1167		FreeMem(FBufferCache);
1168		FBufferCache := nil;
#	Line 893 | Line 1172 | begin
1172		FOldCacheSize := 0;
1173		FMappedFieldPosition := nil;
1174		end;
1175	+	if assigned(FBaseSQLSelect) then FBaseSQLSelect.Free;
1176	+	if assigned(FParser) then FParser.Free;
1177		inherited Destroy;
1178		end;
1179
#	Line 934 | Line 1215 | end;
1215
1216		procedure TIBCustomDataSet.ApplyUpdates;
1217		var
1218	<	{$IF FPC_FULLVERSION > 20600 }
1218	>	{$IF FPC_FULLVERSION >= 20700 }
1219		CurBookmark: TBookmark;
1220		{$ELSE}
1221		CurBookmark: string;
#	Line 1136 | Line 1417 | begin
1417		end;
1418		end;
1419
1420	+	function TIBCustomDataSet.GetFieldPosition(AliasName: string): integer;
1421	+	var i: integer;
1422	+	Prepared: boolean;
1423	+	begin
1424	+	Result := 0;
1425	+	Prepared := FInternalPrepared;
1426	+	if not Prepared then
1427	+	InternalPrepare;
1428	+	try
1429	+	for i := 0 to Length(FAliasNameList) - 1 do
1430	+	if FAliasNameList[i] = AliasName then
1431	+	begin
1432	+	Result := i + 1;
1433	+	Exit
1434	+	end;
1435	+	finally
1436	+	if not Prepared then
1437	+	InternalUnPrepare;
1438	+	end;
1439	+	end;
1440	+
1441		procedure TIBCustomDataSet.ActivateConnection;
1442		begin
1443		if not Assigned(Database) then
#	Line 1196 | Line 1498 | begin
1498		IBError(ibxeDatasetClosed, [nil]);
1499		end;
1500
1501	+	function TIBCustomDataSet.CreateParser: TSelectSQLParser;
1502	+	begin
1503	+	Result := TSelectSQLParser.Create(self,FBaseSQLSelect);
1504	+	Result.OnSQLChanging := SQLChanging
1505	+	end;
1506	+
1507		procedure TIBCustomDataSet.CheckNotUniDirectional;
1508		begin
1509		if UniDirectional then
#	Line 1299 | Line 1607 | begin
1607		FDatabaseFree(Sender);
1608		end;
1609
1610	<	procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject);
1610	>	procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject;
1611	>	Action: TTransactionAction);
1612		begin
1613	<	if Active then
1614	<	Active := False;
1613	>	FCloseAction := Action;
1614	>	FInTransactionEnd := true;
1615	>	try
1616	>	if Active then
1617	>	Active := False;
1618	>	finally
1619	>	FInTransactionEnd := false;
1620	>	end;
1621		if FQSelect <> nil then
1622		FQSelect.FreeHandle;
1623		if FQDelete <> nil then
#	Line 1340 | Line 1655 | var
1655		LocalData: Pointer;
1656		LocalDate, LocalDouble: Double;
1657		LocalInt: Integer;
1658	+	LocalBool: wordBool;
1659		LocalInt64: Int64;
1660		LocalCurrency: Currency;
1661		FieldsLoaded: Integer;
#	Line 1484 | Line 1800 | begin
1800		end;
1801		end;
1802		end;
1803	+	SQL_BOOLEAN:
1804	+	begin
1805	+	LocalBool:= false;
1806	+	rdFields[j].fdDataSize := SizeOf(wordBool);
1807	+	if RecordNumber >= 0 then
1808	+	LocalBool := Qry.Current[i].AsBoolean;
1809	+	LocalData := PChar(@LocalBool);
1810	+	end;
1811		else { SQL_TEXT, SQL_BLOB, SQL_ARRAY, SQL_QUAD }
1812		begin
1813		rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
#	Line 1626 | Line 1950 | function TIBCustomDataSet.InternalLocate
1950		const KeyValues: Variant; Options: TLocateOptions): Boolean;
1951		var
1952		keyFieldList: TList;
1953	<	{$IF FPC_FULLVERSION > 20600 }
1953	>	{$IF FPC_FULLVERSION >= 20700 }
1954		CurBookmark: TBookmark;
1955		{$ELSE}
1956		CurBookmark: string;
#	Line 1755 | Line 2079 | end;
2079		procedure TIBCustomDataSet.InternalRefreshRow;
2080		var
2081		Buff: PChar;
1758	–	SetCursor: Boolean;
2082		ofs: DWORD;
2083		Qry: TIBSQL;
2084		begin
2085	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1763	<	if SetCursor then
1764	<	Screen.Cursor := crHourGlass;
2085	>	FBase.SetCursor;
2086		try
2087		Buff := GetActiveBuf;
2088		if CanRefresh then
#	Line 1805 | Line 2126 | begin
2126		else
2127		IBError(ibxeCannotRefresh, [nil]);
2128		finally
2129	<	if SetCursor and (Screen.Cursor = crHourGlass) then
1809	<	Screen.Cursor := crDefault;
2129	>	FBase.RestoreCursor;
2130		end;
2131		end;
2132
#	Line 1877 | Line 2197 | end;
2197
2198		procedure TIBCustomDataSet.InternalPrepare;
2199		var
1880	–	SetCursor: Boolean;
2200		DidActivate: Boolean;
2201		begin
2202		if FInternalPrepared then
2203		Exit;
2204		DidActivate := False;
2205	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1887	<	if SetCursor then
1888	<	Screen.Cursor := crHourGlass;
2205	>	FBase.SetCursor;
2206		try
2207		ActivateConnection;
2208		DidActivate := ActivateTransaction;
2209		FBase.CheckDatabase;
2210		FBase.CheckTransaction;
2211	+	if HasParser and (FParser.SQLText <> FQSelect.SQL.Text) then
2212	+	begin
2213	+	FQSelect.OnSQLChanged := nil; {Do not react to change}
2214	+	try
2215	+	FQSelect.SQL.Text := FParser.SQLText;
2216	+	finally
2217	+	FQSelect.OnSQLChanged := SQLChanged;
2218	+	end;
2219	+	end;
2220	+	//   writeln( FQSelect.SQL.Text);
2221		if FQSelect.SQL.Text <> '' then
2222		begin
2223		if not FQSelect.Prepared then
2224		begin
2225	+	FQSelect.GenerateParamNames := FGenerateParamNames;
2226		FQSelect.ParamCheck := ParamCheck;
2227		FQSelect.Prepare;
2228		end;
2229	+	FQDelete.GenerateParamNames := FGenerateParamNames;
2230		if (Trim(FQDelete.SQL.Text) <> '') and (not FQDelete.Prepared) then
2231		FQDelete.Prepare;
2232	+	FQInsert.GenerateParamNames := FGenerateParamNames;
2233		if (Trim(FQInsert.SQL.Text) <> '') and (not FQInsert.Prepared) then
2234		FQInsert.Prepare;
2235	+	FQRefresh.GenerateParamNames := FGenerateParamNames;
2236		if (Trim(FQRefresh.SQL.Text) <> '') and (not FQRefresh.Prepared) then
2237		FQRefresh.Prepare;
2238	+	FQModify.GenerateParamNames := FGenerateParamNames;
2239		if (Trim(FQModify.SQL.Text) <> '') and (not FQModify.Prepared) then
2240		FQModify.Prepare;
2241		FInternalPrepared := True;
#	Line 1913 | Line 2245 | begin
2245		finally
2246		if DidActivate then
2247		DeactivateTransaction;
2248	<	if SetCursor and (Screen.Cursor = crHourGlass) then
1917	<	Screen.Cursor := crDefault;
2248	>	FBase.RestoreCursor;
2249		end;
2250		end;
2251
#	Line 2105 | Line 2436 | begin
2436		SQL_TIMESTAMP:
2437		Qry.Params[i].AsDateTime :=
2438		TimeStampToDateTime(MSecsToTimeStamp(trunc(PDouble(data)^)));
2439	+	SQL_BOOLEAN:
2440	+	Qry.Params[i].AsBoolean := PWordBool(data)^;
2441		end;
2442		end;
2443		end;
#	Line 2190 | Line 2523 | begin
2523		end;
2524		end;
2525
2526	+	procedure TIBCustomDataSet.RegisterIBLink(Sender: TIBControlLink);
2527	+	begin
2528	+	if FIBLinks.IndexOf(Sender) = -1 then
2529	+	FIBLinks.Add(Sender);
2530	+	end;
2531	+
2532
2533		procedure TIBCustomDataSet.SQLChanging(Sender: TObject);
2534		begin
2535	<	if FOpen then
2536	<	InternalClose;
2535	>	Active := false;
2536	>	{  if FOpen then
2537	>	InternalClose;}
2538		if FInternalPrepared then
2539		InternalUnPrepare;
2540	+	FieldDefs.Clear;
2541	+	FieldDefs.Updated := false;
2542	+	end;
2543	+
2544	+	procedure TIBCustomDataSet.SQLChanged(Sender: TObject);
2545	+	begin
2546	+	FBaseSQLSelect.assign(FQSelect.SQL);
2547		end;
2548
2549		{ I can "undelete" uninserted records (make them "inserted" again).
#	Line 2225 | Line 2572 | begin
2572		end;
2573		end;
2574
2575	+	procedure TIBCustomDataSet.UnRegisterIBLink(Sender: TIBControlLink);
2576	+	begin
2577	+	FIBLinks.Remove(Sender);
2578	+	end;
2579	+
2580		function TIBCustomDataSet.UpdateStatus: TUpdateStatus;
2581		begin
2582		if Active then
#	Line 2454 | Line 2806 | begin
2806		inherited DoBeforeDelete;
2807		end;
2808
2809	+	procedure TIBCustomDataSet.DoAfterDelete;
2810	+	begin
2811	+	inherited DoAfterDelete;
2812	+	FBase.DoAfterDelete(self);
2813	+	InternalAutoCommit;
2814	+	end;
2815	+
2816		procedure TIBCustomDataSet.DoBeforeEdit;
2817		var
2818		Buff: PRecordData;
#	Line 2468 | Line 2827 | begin
2827		inherited DoBeforeEdit;
2828		end;
2829
2830	+	procedure TIBCustomDataSet.DoAfterEdit;
2831	+	begin
2832	+	inherited DoAfterEdit;
2833	+	FBase.DoAfterEdit(self);
2834	+	end;
2835	+
2836		procedure TIBCustomDataSet.DoBeforeInsert;
2837		begin
2838		if not CanInsert then
#	Line 2480 | Line 2845 | begin
2845		if GeneratorField.ApplyOnEvent = gaeOnNewRecord then
2846		GeneratorField.Apply;
2847		inherited DoAfterInsert;
2848	+	FBase.DoAfterInsert(self);
2849	+	end;
2850	+
2851	+	procedure TIBCustomDataSet.DoBeforeClose;
2852	+	begin
2853	+	inherited DoBeforeClose;
2854	+	if State in [dsInsert,dsEdit] then
2855	+	begin
2856	+	if FInTransactionEnd and (FCloseAction = TARollback) then
2857	+	Exit;
2858	+
2859	+	if DataSetCloseAction = dcSaveChanges then
2860	+	Post;
2861	+	{Note this can fail with an exception e.g. due to
2862	+	database validation error. In which case the dataset remains open }
2863	+	end;
2864	+	end;
2865	+
2866	+	procedure TIBCustomDataSet.DoBeforeOpen;
2867	+	var i: integer;
2868	+	begin
2869	+	if assigned(FParser) then
2870	+	FParser.Reset;
2871	+	for i := 0 to FIBLinks.Count - 1 do
2872	+	TIBControlLink(FIBLinks[i]).UpdateSQL(self);
2873	+	inherited DoBeforeOpen;
2874	+	for i := 0 to FIBLinks.Count - 1 do
2875	+	TIBControlLink(FIBLinks[i]).UpdateParams(self);
2876		end;
2877
2878		procedure TIBCustomDataSet.DoBeforePost;
#	Line 2490 | Line 2883 | begin
2883		GeneratorField.Apply
2884		end;
2885
2886	+	procedure TIBCustomDataSet.DoAfterPost;
2887	+	begin
2888	+	inherited DoAfterPost;
2889	+	FBase.DoAfterPost(self);
2890	+	InternalAutoCommit;
2891	+	end;
2892	+
2893		procedure TIBCustomDataSet.FetchAll;
2894		var
2895	<	SetCursor: Boolean;
2496	<	{$IF FPC_FULLVERSION > 20600 }
2895	>	{$IF FPC_FULLVERSION >= 20700 }
2896		CurBookmark: TBookmark;
2897		{$ELSE}
2898		CurBookmark: string;
2899		{$ENDIF}
2900		begin
2901	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
2902	<	if SetCursor then
2504	<	Screen.Cursor := crHourGlass;
2505	<	try
2901	>	FBase.SetCursor;
2902	>	try
2903		if FQSelect.EOF or not FQSelect.Open then
2904		exit;
2905		DisableControls;
#	Line 2514 | Line 2911 | begin
2911		EnableControls;
2912		end;
2913		finally
2914	<	if SetCursor and (Screen.Cursor = crHourGlass) then
2518	<	Screen.Cursor := crDefault;
2914	>	FBase.RestoreCursor;
2915		end;
2916		end;
2917
#	Line 2563 | Line 2959 | begin
2959		result := FDataLink.DataSource;
2960		end;
2961
2962	+	function TIBCustomDataSet.GetDBAliasName(FieldNo: integer): string;
2963	+	begin
2964	+	Result := FAliasNameMap[FieldNo-1]
2965	+	end;
2966	+
2967	+	function TIBCustomDataSet.GetFieldDefFromAlias(aliasName: string): TFieldDef;
2968	+	var
2969	+	i: integer;
2970	+	begin
2971	+	Result := nil;
2972	+	for i := 0 to Length(FAliasNameMap) - 1 do
2973	+	if FAliasNameMap[i] = aliasName then
2974	+	begin
2975	+	Result := FieldDefs[i];
2976	+	Exit
2977	+	end;
2978	+	end;
2979	+
2980		function TIBCustomDataSet.GetFieldClass(FieldType: TFieldType): TFieldClass;
2981		begin
2982		Result := DefaultFieldClasses[FieldType];
#	Line 2603 | Line 3017 | begin
3017		Data := Buff + CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs;
3018		if (fdDataType = SQL_VARYING) or (fdDataType = SQL_TEXT) then
3019		begin
3020	<	if fdDataLength <= Field.Size then
3020	>	if fdDataLength < Field.DataSize then
3021		begin
3022		Move(Data^, Buffer^, fdDataLength);
3023		PChar(Buffer)[fdDataLength] := #0;
#	Line 2652 | Line 3066 | begin
3066		if not Accept and (GetMode = gmCurrent) then
3067		GetMode := gmPrior;
3068		except
3069	<	//        Application.HandleException(Self);
3069	>	//        FBase.HandleException(Self);
3070		end;
3071		end;
3072		RestoreState(SaveState);
#	Line 2746 | Line 3160 | begin
3160		result := FRecordBufferSize;
3161		end;
3162
3163	+	procedure TIBCustomDataSet.InternalAutoCommit;
3164	+	begin
3165	+	with Transaction do
3166	+	if InTransaction and (FAutoCommit = acCommitRetaining) then
3167	+	begin
3168	+	if CachedUpdates then ApplyUpdates;
3169	+	CommitRetaining;
3170	+	end;
3171	+	end;
3172	+
3173		procedure TIBCustomDataSet.InternalAddRecord(Buffer: Pointer; Append: Boolean);
3174		begin
3175		CheckEditState;
#	Line 2817 | Line 3241 | begin
3241		FreeMem(FOldBufferCache);
3242		FOldBufferCache := nil;
3243		BindFields(False);
3244	+	ResetParser;
3245		if DefaultFields then DestroyFields;
3246		end;
3247
3248		procedure TIBCustomDataSet.InternalDelete;
3249		var
3250		Buff: PChar;
2826	–	SetCursor: Boolean;
3251		begin
3252	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
2829	<	if SetCursor then
2830	<	Screen.Cursor := crHourGlass;
3252	>	FBase.SetCursor;
3253		try
3254		Buff := GetActiveBuf;
3255		if CanDelete then
#	Line 2852 | Line 3274 | begin
3274		end else
3275		IBError(ibxeCannotDelete, [nil]);
3276		finally
3277	<	if SetCursor and (Screen.Cursor = crHourGlass) then
2856	<	Screen.Cursor := crDefault;
3277	>	FBase.RestoreCursor;
3278		end;
3279		end;
3280
#	Line 2869 | Line 3290 | end;
3290
3291		procedure TIBCustomDataSet.InternalHandleException;
3292		begin
3293	<	Application.HandleException(Self)
3293	>	FBase.HandleException(Self)
3294		end;
3295
3296		procedure TIBCustomDataSet.InternalInitFieldDefs;
3297	+	begin
3298	+	if not InternalPrepared then
3299	+	begin
3300	+	InternalPrepare;
3301	+	exit;
3302	+	end;
3303	+	FieldDefsFromQuery(FQSelect);
3304	+	end;
3305	+
3306	+	procedure TIBCustomDataSet.FieldDefsFromQuery(SourceQuery: TIBSQL);
3307		const
3308		DefaultSQL = 'Select F.RDB$COMPUTED_BLR, ' + {do not localize}
3309		'F.RDB$DEFAULT_VALUE, R.RDB$FIELD_NAME ' + {do not localize}
#	Line 2884 | Line 3315 | const
3315		var
3316		FieldType: TFieldType;
3317		FieldSize: Word;
3318	+	charSetID: short;
3319	+	CharSetSize: integer;
3320	+	CharSetName: string;
3321		FieldNullable : Boolean;
3322		i, FieldPosition, FieldPrecision: Integer;
3323	<	FieldAliasName: string;
3323	>	FieldAliasName, DBAliasName: string;
3324		RelationName, FieldName: string;
3325		Query : TIBSQL;
3326		FieldIndex: Integer;
#	Line 2986 | Line 3420 | var
3420		end;
3421
3422		begin
2989	–	if not InternalPrepared then
2990	–	begin
2991	–	InternalPrepare;
2992	–	exit;
2993	–	end;
3423		FRelationNodes := TRelationNode.Create;
3424		FNeedsRefresh := False;
3425		Database.InternalTransaction.StartTransaction;
#	Line 3001 | Line 3430 | begin
3430		FieldDefs.BeginUpdate;
3431		FieldDefs.Clear;
3432		FieldIndex := 0;
3433	<	if (Length(FMappedFieldPosition) < FQSelect.Current.Count) then
3434	<	SetLength(FMappedFieldPosition, FQSelect.Current.Count);
3433	>	if (Length(FMappedFieldPosition) < SourceQuery.Current.Count) then
3434	>	SetLength(FMappedFieldPosition, SourceQuery.Current.Count);
3435		Query.SQL.Text := DefaultSQL;
3436		Query.Prepare;
3437	<	for i := 0 to FQSelect.Current.Count - 1 do
3438	<	with FQSelect.Current[i].Data^ do
3437	>	SetLength(FAliasNameMap, SourceQuery.Current.Count);
3438	>	SetLength(FAliasNameList, SourceQuery.Current.Count);
3439	>	for i := 0 to SourceQuery.Current.Count - 1 do
3440	>	with SourceQuery.Current[i].Data^ do
3441		begin
3442		{ Get the field name }
3443	<	SetString(FieldAliasName, aliasname, aliasname_length);
3443	>	FieldAliasName := SourceQuery.Current[i].Name;
3444	>	SetString(DBAliasName, aliasname, aliasname_length);
3445		SetString(RelationName, relname, relname_length);
3446		SetString(FieldName, sqlname, sqlname_length);
3447	+	FAliasNameList[i] := DBAliasName;
3448		FieldSize := 0;
3449		FieldPrecision := 0;
3450	<	FieldNullable := FQSelect.Current[i].IsNullable;
3450	>	FieldNullable := SourceQuery.Current[i].IsNullable;
3451	>	CharSetSize := 0;
3452	>	CharSetName := '';
3453		case sqltype and not 1 of
3454		{ All VARCHAR's must be converted to strings before recording
3455		their values }
3456		SQL_VARYING, SQL_TEXT:
3457		begin
3458	+	CharSetSize := FBase.GetCharSetSize(sqlsubtype and $FF);
3459	+	CharSetName := FBase.GetCharSetName(sqlsubtype and $FF);
3460	+	{FieldSize is encoded for strings - see TIBStringField.SetSize for decode}
3461		FieldSize := sqllen;
3462	<	FieldType := ftString;
3462	>	if CharSetSize = 2 then
3463	>	FieldType := ftWideString
3464	>	else
3465	>	FieldType := ftString;
3466		end;
3467		{ All Doubles/Floats should be cast to doubles }
3468		SQL_DOUBLE, SQL_FLOAT:
#	Line 3080 | Line 3521 | begin
3521		begin
3522		FieldSize := sizeof (TISC_QUAD);
3523		if (sqlsubtype = 1) then
3524	<	FieldType := ftmemo
3524	>	begin
3525	>	if strpas(sqlname) = '' then {Complex SQL with no identifiable column - use connection default}
3526	>	begin
3527	>	CharSetSize := FBase.GetDefaultCharSetSize;
3528	>	CharSetName := FBase.GetDefaultCharSetName;
3529	>	end
3530	>	else
3531	>	begin
3532	>	charSetID := GetBlobCharSetID(Database.Handle,Database.InternalTransaction.Handle,
3533	>	@relname,@sqlname);
3534	>	CharSetSize := FBase.GetCharSetSize(charSetID);
3535	>	CharSetName := FBase.GetCharSetName(charSetID);
3536	>	end;
3537	>	if CharSetSize = 2 then
3538	>	FieldType := ftWideMemo
3539	>	else
3540	>	FieldType := ftMemo;
3541	>	end
3542		else
3543		FieldType := ftBlob;
3544		end;
#	Line 3089 | Line 3547 | begin
3547		FieldSize := sizeof (TISC_QUAD);
3548		FieldType := ftUnknown;
3549		end;
3550	+	SQL_BOOLEAN:
3551	+	FieldType:= ftBoolean;
3552		else
3553		FieldType := ftUnknown;
3554		end;
#	Line 3097 | Line 3557 | begin
3557		begin
3558		FMappedFieldPosition[FieldIndex] := FieldPosition;
3559		Inc(FieldIndex);
3560	<	with FieldDefs.AddFieldDef do
3560	>	with TIBFieldDef.Create(FieldDefs,'',FieldType,0,False,FieldDefs.Count+1) do
3561		begin
3562		Name := FieldAliasName;
3563	<	(*           FieldNo := FieldPosition;*)
3104	<	DataType := FieldType;
3563	>	FAliasNameMap[FieldNo-1] := DBAliasName;
3564		Size := FieldSize;
3565		Precision := FieldPrecision;
3566		Required := not FieldNullable;
3567		InternalCalcField := False;
3568	+	CharacterSetSize := CharSetSize;
3569	+	CharacterSetName := CharSetName;
3570		if (FieldName <> '') and (RelationName <> '') then
3571		begin
3572		if Has_COMPUTED_BLR(RelationName, FieldName) then
#	Line 3185 | Line 3646 | begin
3646		else case cur_field.DataType of
3647		ftString:
3648		cur_param.AsString := cur_field.AsString;
3649	<	ftBoolean, ftSmallint, ftWord:
3649	>	ftBoolean:
3650	>	cur_param.AsBoolean := cur_field.AsBoolean;
3651	>	ftSmallint, ftWord:
3652		cur_param.AsShort := cur_field.AsInteger;
3653		ftInteger:
3654		cur_param.AsLong := cur_field.AsInteger;
#	Line 3238 | Line 3701 | begin
3701		end;
3702
3703		procedure TIBCustomDataSet.InternalOpen;
3241	–	var
3242	–	SetCursor: Boolean;
3704
3705		function RecordDataLength(n: Integer): Long;
3706		begin
3707		result := SizeOf(TRecordData) + ((n - 1) * SizeOf(TFieldData));
3708		end;
3709
3710	+	function GetFieldDef(aFieldNo: integer): TIBFieldDef;
3711	+	var i: integer;
3712	+	begin
3713	+	Result := nil;
3714	+	for i := 0 to FieldDefs.Count - 1 do
3715	+	if FieldDefs[i].FieldNo = aFieldNo then
3716	+	begin
3717	+	Result := TIBFieldDef(FieldDefs[i]);
3718	+	break;
3719	+	end;
3720	+	end;
3721	+
3722	+	procedure SetExtendedProperties;
3723	+	var i: integer;
3724	+	IBFieldDef: TIBFieldDef;
3725	+	begin
3726	+	for i := 0 to Fields.Count - 1 do
3727	+	if Fields[i].FieldNo > 0 then
3728	+	begin
3729	+	if(Fields[i] is TIBStringField) then
3730	+	with TIBStringField(Fields[i]) do
3731	+	begin
3732	+	IBFieldDef := GetFieldDef(FieldNo);
3733	+	if IBFieldDef <> nil then
3734	+	begin
3735	+	CharacterSetSize := IBFieldDef.CharacterSetSize;
3736	+	CharacterSetName := IBFieldDef.CharacterSetName;
3737	+	end;
3738	+	end
3739	+	else
3740	+	if(Fields[i] is TIBWideStringField) then
3741	+	with TIBWideStringField(Fields[i]) do
3742	+	begin
3743	+	IBFieldDef := GetFieldDef(FieldNo);
3744	+	if IBFieldDef <> nil then
3745	+	begin
3746	+	CharacterSetSize := IBFieldDef.CharacterSetSize;
3747	+	CharacterSetName := IBFieldDef.CharacterSetName;
3748	+	end;
3749	+	end
3750	+	else
3751	+	if(Fields[i] is TIBMemoField) then
3752	+	with TIBMemoField(Fields[i]) do
3753	+	begin
3754	+	IBFieldDef := GetFieldDef(FieldNo);
3755	+	if IBFieldDef <> nil then
3756	+	begin
3757	+	CharacterSetSize := IBFieldDef.CharacterSetSize;
3758	+	CharacterSetName := IBFieldDef.CharacterSetName;
3759	+	end;
3760	+	end
3761	+	else
3762	+	if(Fields[i] is TIBWideMemoField) then
3763	+	with TIBWideMemoField(Fields[i]) do
3764	+	begin
3765	+	IBFieldDef := GetFieldDef(FieldNo);
3766	+	if IBFieldDef <> nil then
3767	+	begin
3768	+	CharacterSetSize := IBFieldDef.CharacterSetSize;
3769	+	CharacterSetName := IBFieldDef.CharacterSetName;
3770	+	end;
3771	+	end
3772	+	end
3773	+	end;
3774	+
3775		begin
3776	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3251	<	if SetCursor then
3252	<	Screen.Cursor := crHourGlass;
3776	>	FBase.SetCursor;
3777		try
3778		ActivateConnection;
3779		ActivateTransaction;
#	Line 3262 | Line 3786 | begin
3786		if DefaultFields then
3787		CreateFields;
3788		BindFields(True);
3789	+	SetExtendedProperties;
3790		FCurrentRecord := -1;
3791		FQSelect.ExecQuery;
3792		FOpen := FQSelect.Open;
#	Line 3310 | Line 3835 | begin
3835		else
3836		FQSelect.ExecQuery;
3837		finally
3838	<	if SetCursor and (Screen.Cursor = crHourGlass) then
3314	<	Screen.Cursor := crDefault;
3838	>	FBase.RestoreCursor;
3839		end;
3840		end;
3841
#	Line 3319 | Line 3843 | procedure TIBCustomDataSet.InternalPost;
3843		var
3844		Qry: TIBSQL;
3845		Buff: PChar;
3322	–	SetCursor: Boolean;
3846		bInserting: Boolean;
3847		begin
3848	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3326	<	if SetCursor then
3327	<	Screen.Cursor := crHourGlass;
3848	>	FBase.SetCursor;
3849		try
3850		Buff := GetActiveBuf;
3851		CheckEditState;
#	Line 3362 | Line 3883 | begin
3883		if bInserting then
3884		Inc(FRecordCount);
3885		finally
3886	<	if SetCursor and (Screen.Cursor = crHourGlass) then
3366	<	Screen.Cursor := crDefault;
3886	>	FBase.RestoreCursor;
3887		end;
3888		end;
3889
#	Line 3383 | Line 3903 | begin
3903		result := FOpen;
3904		end;
3905
3906	+	procedure TIBCustomDataSet.Loaded;
3907	+	begin
3908	+	if assigned(FQSelect) then
3909	+	FBaseSQLSelect.assign(FQSelect.SQL);
3910	+	inherited Loaded;
3911	+	end;
3912	+
3913	+	procedure TIBCustomDataSet.Post;
3914	+	var CancelPost: boolean;
3915	+	begin
3916	+	CancelPost := false;
3917	+	if assigned(FOnValidatePost) then
3918	+	OnValidatePost(self,CancelPost);
3919	+	if CancelPost then
3920	+	Cancel
3921	+	else
3922	+	inherited Post;
3923	+	end;
3924	+
3925		function TIBCustomDataSet.Locate(const KeyFields: string; const KeyValues: Variant;
3926		Options: TLocateOptions): Boolean;
3927		var
3928	<	{$IF FPC_FULLVERSION > 20600 }
3928	>	{$IF FPC_FULLVERSION >= 20700 }
3929		CurBookmark: TBookmark;
3930		{$ELSE}
3931		CurBookmark: string;
#	Line 3408 | Line 3947 | function TIBCustomDataSet.Lookup(const K
3947		const ResultFields: string): Variant;
3948		var
3949		fl: TList;
3950	<	{$IF FPC_FULLVERSION > 20600 }
3950	>	{$IF FPC_FULLVERSION >= 20700 }
3951		CurBookmark: TBookmark;
3952		{$ELSE}
3953		CurBookmark: string;
#	Line 3465 | Line 4004 | end;
4004		procedure TIBCustomDataSet.InternalSetFieldData(Field: TField; Buffer: Pointer);
4005		var
4006		Buff, TmpBuff: PChar;
4007	+	MappedFieldPos: integer;
4008		begin
4009		Buff := GetActiveBuf;
4010		if Field.FieldNo < 0 then
#	Line 3481 | Line 4021 | begin
4021		begin
4022		{ If inserting, Adjust record position }
4023		AdjustRecordOnInsert(Buff);
4024	<	if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and
4025	<	(FMappedFieldPosition[Field.FieldNo - 1] <= rdFieldCount) then
4024	>	MappedFieldPos := FMappedFieldPosition[Field.FieldNo - 1];
4025	>	if (MappedFieldPos > 0) and
4026	>	(MappedFieldPos <= rdFieldCount) then
4027		begin
4028		Field.Validate(Buffer);
4029		if (Buffer = nil) or
4030		(Field is TIBStringField) and (PChar(Buffer)[0] = #0) then
4031	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull := True
4031	>	rdFields[MappedFieldPos].fdIsNull := True
4032		else begin
4033	<	Move(Buffer^, Buff[rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs],
4034	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataSize);
4035	<	if (rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_TEXT) or
4036	<	(rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_VARYING) then
4037	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataLength := StrLen(PChar(Buffer));
4038	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull := False;
4033	>	Move(Buffer^, Buff[rdFields[MappedFieldPos].fdDataOfs],
4034	>	rdFields[MappedFieldPos].fdDataSize);
4035	>	if (rdFields[MappedFieldPos].fdDataType = SQL_TEXT) or
4036	>	(rdFields[MappedFieldPos].fdDataType = SQL_VARYING) then
4037	>	rdFields[MappedFieldPos].fdDataLength := StrLen(PChar(Buffer));
4038	>	rdFields[MappedFieldPos].fdIsNull := False;
4039		if rdUpdateStatus = usUnmodified then
4040		begin
4041		if CachedUpdates then
#	Line 3582 | Line 4123 | begin
4123		FillChar(Buffer[FRecordSize], CalcFieldsSize, 0);
4124		end;
4125
4126	+	procedure TIBCustomDataSet.ClearIBLinks;
4127	+	var i: integer;
4128	+	begin
4129	+	for i := FIBLinks.Count - 1 downto 0 do
4130	+	TIBControlLink(FIBLinks[i]).IBDataSet := nil;
4131	+	end;
4132	+
4133
4134		procedure TIBCustomDataSet.InternalUnPrepare;
4135		begin
#	Line 3589 | Line 4137 | begin
4137		begin
4138		CheckDatasetClosed;
4139		FieldDefs.Clear;
4140	+	FieldDefs.Updated := false;
4141		FInternalPrepared := False;
4142	+	Setlength(FAliasNameList,0);
4143		end;
4144		end;
4145
4146		procedure TIBCustomDataSet.InternalExecQuery;
4147		var
4148		DidActivate: Boolean;
3599	–	SetCursor: Boolean;
4149		begin
4150		DidActivate := False;
4151	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3603	<	if SetCursor then
3604	<	Screen.Cursor := crHourGlass;
4151	>	FBase.SetCursor;
4152		try
4153		ActivateConnection;
4154		DidActivate := ActivateTransaction;
#	Line 3618 | Line 4165 | begin
4165		finally
4166		if DidActivate then
4167		DeactivateTransaction;
4168	<	if SetCursor and (Screen.Cursor = crHourGlass) then
3622	<	Screen.Cursor := crDefault;
4168	>	FBase.RestoreCursor;
4169		end;
4170		end;
4171
#	Line 3628 | Line 4174 | begin
4174		Result := FQSelect.Handle;
4175		end;
4176
4177	+	function TIBCustomDataSet.GetParser: TSelectSQLParser;
4178	+	begin
4179	+	if not assigned(FParser) then
4180	+	FParser := CreateParser;
4181	+	Result := FParser
4182	+	end;
4183	+
4184	+	procedure TIBCustomDataSet.ResetParser;
4185	+	begin
4186	+	if assigned(FParser) then
4187	+	begin
4188	+	FParser.Free;
4189	+	FParser := nil;
4190	+	FQSelect.OnSQLChanged := nil; {Do not react to change}
4191	+	try
4192	+	FQSelect.SQL.Assign(FBaseSQLSelect);
4193	+	finally
4194	+	FQSelect.OnSQLChanged := SQLChanged;
4195	+	end;
4196	+	end;
4197	+	end;
4198	+
4199	+	function TIBCustomDataSet.HasParser: boolean;
4200	+	begin
4201	+	Result := not (csDesigning in ComponentState) and (FParser <> nil)
4202	+	end;
4203	+
4204	+	procedure TIBCustomDataSet.SetGenerateParamNames(AValue: Boolean);
4205	+	begin
4206	+	if FGenerateParamNames = AValue then Exit;
4207	+	FGenerateParamNames := AValue;
4208	+	Disconnect
4209	+	end;
4210	+
4211		procedure TIBCustomDataSet.InitRecord(Buffer: PChar);
4212		begin
4213		inherited InitRecord(Buffer);
#	Line 3962 | Line 4542 | begin
4542		FBlobStream.Truncate;
4543		end;
4544
4545	+	destructor TIBDSBlobStream.Destroy;
4546	+	begin
4547	+	if FHasWritten then
4548	+	TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
4549	+	inherited Destroy;
4550	+	end;
4551	+
4552		function TIBDSBlobStream.Read(var Buffer; Count: Longint): Longint;
4553		begin
4554		result := FBlobStream.Read(Buffer, Count);
#	Line 3984 | Line 4571 | begin
4571		TIBCustomDataSet(FField.DataSet).RecordModified(True);
4572		TBlobField(FField).Modified := true;
4573		result := FBlobStream.Write(Buffer, Count);
4574	<	TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
4574	>	FHasWritten := true;
4575	>	{  TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
4576	>	Removed as this caused a seek to beginning of the blob stream thus corrupting
4577	>	the blob stream. Moved to the destructor i.e. called after blob written}
4578		end;
4579
4580		{ TIBGenerator }
#	Line 4031 | Line 4621 | end;
4621
4622		procedure TIBGenerator.Apply;
4623		begin
4624	<	if (FGeneratorName <> '') and (FFieldName <> '')  then
4624	>	if (FGeneratorName <> '') and (FFieldName <> '') and Owner.FieldByName(FFieldName).IsNull then
4625		Owner.FieldByName(FFieldName).AsInteger := GetNextValue(Owner.Database,Owner.Transaction);
4626		end;
4627
4628	+
4629		end.

Diff Legend

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