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 37 by tony, Mon Feb 15 14:44:25 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, 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	>
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	>	{ TIBWideMemoField }
869	>
870	>	function TIBWideMemoField.GetTruncatedText: string;
871	>	begin
872	>	Result := GetAsString;
873	>
874	>	if Result <> '' then
875	>	if DisplayWidth = 0 then
876	>	Result := TextToSingleLine(Result)
877	>	else
878	>	if Length(Result) > DisplayWidth then {Show truncation with elipses}
879	>	Result := TextToSingleLine(system.copy(Result,1,DisplayWidth-3)) + '...';
880	>	end;
881	>
882	>	function TIBWideMemoField.GetDefaultWidth: Longint;
883	>	begin
884	>	Result := 128;
885	>	end;
886	>
887	>	procedure TIBWideMemoField.GetText(var AText: string; ADisplayText: Boolean);
888	>	begin
889	>	if ADisplayText then
890	>	begin
891	>	if not DisplayTextAsClassName then
892	>	AText := GetTruncatedText
893	>	else
894	>	inherited GetText(AText, ADisplayText);
895	>	end
896	>	else
897	>	AText := GetAsString;
898	>	end;
899
900	<	constructor TIBStringField.Create(AOwner: TComponent);
900	>	constructor TIBWideMemoField.Create(AOwner: TComponent);
901		begin
902		inherited Create(AOwner);
903	+	BlobType := ftWideMemo;
904	+	end;
905	+
906	+	{ TIBMemoField }
907	+
908	+	function TIBMemoField.GetTruncatedText: string;
909	+	begin
910	+	Result := GetAsString;
911	+
912	+	if Result <> '' then
913	+	begin
914	+	case CharacterSetSize of
915	+	1:
916	+	if DisplayWidth = 0 then
917	+	Result := TextToSingleLine(Result)
918	+	else
919	+	if Length(Result) > DisplayWidth then {Show truncation with elipses}
920	+	Result := TextToSingleLine(system.copy(Result,1,DisplayWidth-3)) + '...';
921	+
922	+	{2: case 2 ignored. This should be handled by TIBWideMemo}
923	+
924	+	3, {Assume UNICODE_FSS is really UTF8}
925	+	4: {Include GB18030 - assuming UTF8 routine work for this codeset}
926	+	if DisplayWidth = 0 then
927	+	Result := ValidUTF8String(TextToSingleLine(Result))
928	+	else
929	+	if UTF8Length(Result) > DisplayWidth then {Show truncation with elipses}
930	+	Result := ValidUTF8String(TextToSingleLine(UTF8Copy(Result,1,DisplayWidth-3))) + '...';
931	+	end;
932	+	end
933	+	end;
934	+
935	+	function TIBMemoField.GetDefaultWidth: Longint;
936	+	begin
937	+	if DisplayTextAsClassName then
938	+	Result := inherited
939	+	else
940	+	Result := 128;
941	+	end;
942	+
943	+	procedure TIBMemoField.GetText(var AText: string; ADisplayText: Boolean);
944	+	begin
945	+	if ADisplayText then
946	+	begin
947	+	if not DisplayTextAsClassName then
948	+	AText := GetTruncatedText
949	+	else
950	+	inherited GetText(AText, ADisplayText);
951	+	end
952	+	else
953	+	AText := GetAsString;
954	+	end;
955	+
956	+	constructor TIBMemoField.Create(AOwner: TComponent);
957	+	begin
958	+	inherited Create(AOwner);
959	+	BlobType := ftMemo;
960	+	end;
961	+
962	+	{ TIBControlLink }
963	+
964	+	destructor TIBControlLink.Destroy;
965	+	begin
966	+	IBDataSet := nil;
967	+	inherited Destroy;
968	+	end;
969	+
970	+	procedure TIBControlLink.UpdateParams(Sender: TObject);
971	+	begin
972	+
973	+	end;
974	+
975	+	procedure TIBControlLink.UpdateSQL(Sender: TObject);
976	+	begin
977	+
978	+	end;
979	+
980	+	procedure TIBControlLink.SetIBDataSet(AValue: TIBCustomDataSet);
981	+	begin
982	+	if FTIBDataSet = AValue then Exit;
983	+	if IBDataSet <> nil then
984	+	IBDataSet.UnRegisterIBLink(self);
985	+	FTIBDataSet := AValue;
986	+	if IBDataSet <> nil then
987	+	IBDataSet.RegisterIBLink(self);
988	+	end;
989	+
990	+
991	+	{ TIBStringField}
992	+
993	+	function TIBStringField.GetDefaultWidth: Longint;
994	+	begin
995	+	Result := Size div CharacterSetSize;
996	+	end;
997	+
998	+	constructor TIBStringField.Create(aOwner: TComponent);
999	+	begin
1000	+	inherited Create(aOwner);
1001	+	FCharacterSetSize := 1;
1002		end;
1003
1004		class procedure TIBStringField.CheckTypeSize(Value: Integer);
#	Line 738 | Line 1053 | begin
1053		end;
1054		end;
1055
1056	+
1057		{ TIBBCDField }
1058
1059		constructor TIBBCDField.Create(AOwner: TComponent);
#	Line 835 | Line 1151 | begin
1151		CheckIBLoaded;
1152		FIBLoaded := True;
1153		FBase := TIBBase.Create(Self);
1154	+	FIBLinks := TList.Create;
1155		FCurrentRecord := -1;
1156		FDeletedRecords := 0;
1157		FUniDirectional := False;
#	Line 853 | Line 1170 | begin
1170		FQRefresh.GoToFirstRecordOnExecute := False;
1171		FQSelect := TIBSQL.Create(Self);
1172		FQSelect.OnSQLChanging := SQLChanging;
1173	+	FQSelect.OnSQLChanged := SQLChanged;
1174		FQSelect.GoToFirstRecordOnExecute := False;
1175		FQModify := TIBSQL.Create(Self);
1176		FQModify.OnSQLChanging := SQLChanging;
1177		FQModify.GoToFirstRecordOnExecute := False;
1178		FUpdateRecordTypes := [cusUnmodified, cusModified, cusInserted];
1179		FParamCheck := True;
1180	+	FGenerateParamNames := False;
1181		FForcedRefresh := False;
1182	+	FAutoCommit:= acDisabled;
1183	+	FDataSetCloseAction := dcDiscardChanges;
1184		{Bookmark Size is Integer for IBX}
1185		BookmarkSize := SizeOf(Integer);
1186		FBase.BeforeDatabaseDisconnect := DoBeforeDatabaseDisconnect;
#	Line 873 | Line 1194 | begin
1194		else
1195		if AOwner is TIBTransaction then
1196		Transaction := TIBTransaction(AOwner);
1197	+	FBaseSQLSelect := TStringList.Create;
1198		end;
1199
1200		destructor TIBCustomDataSet.Destroy;
#	Line 884 | Line 1206 | begin
1206		FDataLink.Free;
1207		FBase.Free;
1208		ClearBlobCache;
1209	+	ClearIBLinks;
1210	+	FIBLinks.Free;
1211		FBlobStreamList.Free;
1212		FreeMem(FBufferCache);
1213		FBufferCache := nil;
#	Line 893 | Line 1217 | begin
1217		FOldCacheSize := 0;
1218		FMappedFieldPosition := nil;
1219		end;
1220	+	if assigned(FBaseSQLSelect) then FBaseSQLSelect.Free;
1221	+	if assigned(FParser) then FParser.Free;
1222		inherited Destroy;
1223		end;
1224
#	Line 934 | Line 1260 | end;
1260
1261		procedure TIBCustomDataSet.ApplyUpdates;
1262		var
1263	<	{$IF FPC_FULLVERSION > 20600 }
1263	>	{$IF FPC_FULLVERSION >= 20700 }
1264		CurBookmark: TBookmark;
1265		{$ELSE}
1266		CurBookmark: string;
#	Line 1136 | Line 1462 | begin
1462		end;
1463		end;
1464
1465	+	function TIBCustomDataSet.GetFieldPosition(AliasName: string): integer;
1466	+	var i: integer;
1467	+	Prepared: boolean;
1468	+	begin
1469	+	Result := 0;
1470	+	Prepared := FInternalPrepared;
1471	+	if not Prepared then
1472	+	InternalPrepare;
1473	+	try
1474	+	for i := 0 to Length(FAliasNameList) - 1 do
1475	+	if FAliasNameList[i] = AliasName then
1476	+	begin
1477	+	Result := i + 1;
1478	+	Exit
1479	+	end;
1480	+	finally
1481	+	if not Prepared then
1482	+	InternalUnPrepare;
1483	+	end;
1484	+	end;
1485	+
1486		procedure TIBCustomDataSet.ActivateConnection;
1487		begin
1488		if not Assigned(Database) then
#	Line 1196 | Line 1543 | begin
1543		IBError(ibxeDatasetClosed, [nil]);
1544		end;
1545
1546	+	function TIBCustomDataSet.CreateParser: TSelectSQLParser;
1547	+	begin
1548	+	Result := TSelectSQLParser.Create(self,FBaseSQLSelect);
1549	+	Result.OnSQLChanging := SQLChanging
1550	+	end;
1551	+
1552		procedure TIBCustomDataSet.CheckNotUniDirectional;
1553		begin
1554		if UniDirectional then
#	Line 1299 | Line 1652 | begin
1652		FDatabaseFree(Sender);
1653		end;
1654
1655	<	procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject);
1655	>	procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject;
1656	>	Action: TTransactionAction);
1657		begin
1658	<	if Active then
1659	<	Active := False;
1658	>	FCloseAction := Action;
1659	>	FInTransactionEnd := true;
1660	>	try
1661	>	if Active then
1662	>	Active := False;
1663	>	finally
1664	>	FInTransactionEnd := false;
1665	>	end;
1666		if FQSelect <> nil then
1667		FQSelect.FreeHandle;
1668		if FQDelete <> nil then
#	Line 1340 | Line 1700 | var
1700		LocalData: Pointer;
1701		LocalDate, LocalDouble: Double;
1702		LocalInt: Integer;
1703	+	LocalBool: wordBool;
1704		LocalInt64: Int64;
1705		LocalCurrency: Currency;
1706		FieldsLoaded: Integer;
#	Line 1484 | Line 1845 | begin
1845		end;
1846		end;
1847		end;
1848	+	SQL_BOOLEAN:
1849	+	begin
1850	+	LocalBool:= false;
1851	+	rdFields[j].fdDataSize := SizeOf(wordBool);
1852	+	if RecordNumber >= 0 then
1853	+	LocalBool := Qry.Current[i].AsBoolean;
1854	+	LocalData := PChar(@LocalBool);
1855	+	end;
1856		else { SQL_TEXT, SQL_BLOB, SQL_ARRAY, SQL_QUAD }
1857		begin
1858		rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
#	Line 1626 | Line 1995 | function TIBCustomDataSet.InternalLocate
1995		const KeyValues: Variant; Options: TLocateOptions): Boolean;
1996		var
1997		keyFieldList: TList;
1998	<	{$IF FPC_FULLVERSION > 20600 }
1998	>	{$IF FPC_FULLVERSION >= 20700 }
1999		CurBookmark: TBookmark;
2000		{$ELSE}
2001		CurBookmark: string;
#	Line 1755 | Line 2124 | end;
2124		procedure TIBCustomDataSet.InternalRefreshRow;
2125		var
2126		Buff: PChar;
1758	–	SetCursor: Boolean;
2127		ofs: DWORD;
2128		Qry: TIBSQL;
2129		begin
2130	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1763	<	if SetCursor then
1764	<	Screen.Cursor := crHourGlass;
2130	>	FBase.SetCursor;
2131		try
2132		Buff := GetActiveBuf;
2133		if CanRefresh then
#	Line 1805 | Line 2171 | begin
2171		else
2172		IBError(ibxeCannotRefresh, [nil]);
2173		finally
2174	<	if SetCursor and (Screen.Cursor = crHourGlass) then
1809	<	Screen.Cursor := crDefault;
2174	>	FBase.RestoreCursor;
2175		end;
2176		end;
2177
#	Line 1877 | Line 2242 | end;
2242
2243		procedure TIBCustomDataSet.InternalPrepare;
2244		var
1880	–	SetCursor: Boolean;
2245		DidActivate: Boolean;
2246		begin
2247		if FInternalPrepared then
2248		Exit;
2249		DidActivate := False;
2250	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1887	<	if SetCursor then
1888	<	Screen.Cursor := crHourGlass;
2250	>	FBase.SetCursor;
2251		try
2252		ActivateConnection;
2253		DidActivate := ActivateTransaction;
2254		FBase.CheckDatabase;
2255		FBase.CheckTransaction;
2256	+	if HasParser and (FParser.SQLText <> FQSelect.SQL.Text) then
2257	+	begin
2258	+	FQSelect.OnSQLChanged := nil; {Do not react to change}
2259	+	try
2260	+	FQSelect.SQL.Text := FParser.SQLText;
2261	+	finally
2262	+	FQSelect.OnSQLChanged := SQLChanged;
2263	+	end;
2264	+	end;
2265	+	//   writeln( FQSelect.SQL.Text);
2266		if FQSelect.SQL.Text <> '' then
2267		begin
2268		if not FQSelect.Prepared then
2269		begin
2270	+	FQSelect.GenerateParamNames := FGenerateParamNames;
2271		FQSelect.ParamCheck := ParamCheck;
2272		FQSelect.Prepare;
2273		end;
2274	+	FQDelete.GenerateParamNames := FGenerateParamNames;
2275		if (Trim(FQDelete.SQL.Text) <> '') and (not FQDelete.Prepared) then
2276		FQDelete.Prepare;
2277	+	FQInsert.GenerateParamNames := FGenerateParamNames;
2278		if (Trim(FQInsert.SQL.Text) <> '') and (not FQInsert.Prepared) then
2279		FQInsert.Prepare;
2280	+	FQRefresh.GenerateParamNames := FGenerateParamNames;
2281		if (Trim(FQRefresh.SQL.Text) <> '') and (not FQRefresh.Prepared) then
2282		FQRefresh.Prepare;
2283	+	FQModify.GenerateParamNames := FGenerateParamNames;
2284		if (Trim(FQModify.SQL.Text) <> '') and (not FQModify.Prepared) then
2285		FQModify.Prepare;
2286		FInternalPrepared := True;
#	Line 1913 | Line 2290 | begin
2290		finally
2291		if DidActivate then
2292		DeactivateTransaction;
2293	<	if SetCursor and (Screen.Cursor = crHourGlass) then
1917	<	Screen.Cursor := crDefault;
2293	>	FBase.RestoreCursor;
2294		end;
2295		end;
2296
#	Line 2105 | Line 2481 | begin
2481		SQL_TIMESTAMP:
2482		Qry.Params[i].AsDateTime :=
2483		TimeStampToDateTime(MSecsToTimeStamp(trunc(PDouble(data)^)));
2484	+	SQL_BOOLEAN:
2485	+	Qry.Params[i].AsBoolean := PWordBool(data)^;
2486		end;
2487		end;
2488		end;
#	Line 2190 | Line 2568 | begin
2568		end;
2569		end;
2570
2571	+	procedure TIBCustomDataSet.RegisterIBLink(Sender: TIBControlLink);
2572	+	begin
2573	+	if FIBLinks.IndexOf(Sender) = -1 then
2574	+	FIBLinks.Add(Sender);
2575	+	end;
2576	+
2577
2578		procedure TIBCustomDataSet.SQLChanging(Sender: TObject);
2579		begin
2580	<	if FOpen then
2581	<	InternalClose;
2580	>	Active := false;
2581	>	{  if FOpen then
2582	>	InternalClose;}
2583		if FInternalPrepared then
2584		InternalUnPrepare;
2585	+	FieldDefs.Clear;
2586	+	FieldDefs.Updated := false;
2587	+	end;
2588	+
2589	+	procedure TIBCustomDataSet.SQLChanged(Sender: TObject);
2590	+	begin
2591	+	FBaseSQLSelect.assign(FQSelect.SQL);
2592		end;
2593
2594		{ I can "undelete" uninserted records (make them "inserted" again).
#	Line 2225 | Line 2617 | begin
2617		end;
2618		end;
2619
2620	+	procedure TIBCustomDataSet.UnRegisterIBLink(Sender: TIBControlLink);
2621	+	begin
2622	+	FIBLinks.Remove(Sender);
2623	+	end;
2624	+
2625		function TIBCustomDataSet.UpdateStatus: TUpdateStatus;
2626		begin
2627		if Active then
#	Line 2454 | Line 2851 | begin
2851		inherited DoBeforeDelete;
2852		end;
2853
2854	+	procedure TIBCustomDataSet.DoAfterDelete;
2855	+	begin
2856	+	inherited DoAfterDelete;
2857	+	FBase.DoAfterDelete(self);
2858	+	InternalAutoCommit;
2859	+	end;
2860	+
2861		procedure TIBCustomDataSet.DoBeforeEdit;
2862		var
2863		Buff: PRecordData;
#	Line 2468 | Line 2872 | begin
2872		inherited DoBeforeEdit;
2873		end;
2874
2875	+	procedure TIBCustomDataSet.DoAfterEdit;
2876	+	begin
2877	+	inherited DoAfterEdit;
2878	+	FBase.DoAfterEdit(self);
2879	+	end;
2880	+
2881		procedure TIBCustomDataSet.DoBeforeInsert;
2882		begin
2883		if not CanInsert then
#	Line 2480 | Line 2890 | begin
2890		if GeneratorField.ApplyOnEvent = gaeOnNewRecord then
2891		GeneratorField.Apply;
2892		inherited DoAfterInsert;
2893	+	FBase.DoAfterInsert(self);
2894	+	end;
2895	+
2896	+	procedure TIBCustomDataSet.DoBeforeClose;
2897	+	begin
2898	+	inherited DoBeforeClose;
2899	+	if State in [dsInsert,dsEdit] then
2900	+	begin
2901	+	if FInTransactionEnd and (FCloseAction = TARollback) then
2902	+	Exit;
2903	+
2904	+	if DataSetCloseAction = dcSaveChanges then
2905	+	Post;
2906	+	{Note this can fail with an exception e.g. due to
2907	+	database validation error. In which case the dataset remains open }
2908	+	end;
2909	+	end;
2910	+
2911	+	procedure TIBCustomDataSet.DoBeforeOpen;
2912	+	var i: integer;
2913	+	begin
2914	+	if assigned(FParser) then
2915	+	FParser.Reset;
2916	+	for i := 0 to FIBLinks.Count - 1 do
2917	+	TIBControlLink(FIBLinks[i]).UpdateSQL(self);
2918	+	inherited DoBeforeOpen;
2919	+	for i := 0 to FIBLinks.Count - 1 do
2920	+	TIBControlLink(FIBLinks[i]).UpdateParams(self);
2921		end;
2922
2923		procedure TIBCustomDataSet.DoBeforePost;
#	Line 2490 | Line 2928 | begin
2928		GeneratorField.Apply
2929		end;
2930
2931	+	procedure TIBCustomDataSet.DoAfterPost;
2932	+	begin
2933	+	inherited DoAfterPost;
2934	+	FBase.DoAfterPost(self);
2935	+	InternalAutoCommit;
2936	+	end;
2937	+
2938		procedure TIBCustomDataSet.FetchAll;
2939		var
2940	<	SetCursor: Boolean;
2496	<	{$IF FPC_FULLVERSION > 20600 }
2940	>	{$IF FPC_FULLVERSION >= 20700 }
2941		CurBookmark: TBookmark;
2942		{$ELSE}
2943		CurBookmark: string;
2944		{$ENDIF}
2945		begin
2946	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
2947	<	if SetCursor then
2504	<	Screen.Cursor := crHourGlass;
2505	<	try
2946	>	FBase.SetCursor;
2947	>	try
2948		if FQSelect.EOF or not FQSelect.Open then
2949		exit;
2950		DisableControls;
#	Line 2514 | Line 2956 | begin
2956		EnableControls;
2957		end;
2958		finally
2959	<	if SetCursor and (Screen.Cursor = crHourGlass) then
2518	<	Screen.Cursor := crDefault;
2959	>	FBase.RestoreCursor;
2960		end;
2961		end;
2962
#	Line 2563 | Line 3004 | begin
3004		result := FDataLink.DataSource;
3005		end;
3006
3007	+	function TIBCustomDataSet.GetDBAliasName(FieldNo: integer): string;
3008	+	begin
3009	+	Result := FAliasNameMap[FieldNo-1]
3010	+	end;
3011	+
3012	+	function TIBCustomDataSet.GetFieldDefFromAlias(aliasName: string): TFieldDef;
3013	+	var
3014	+	i: integer;
3015	+	begin
3016	+	Result := nil;
3017	+	for i := 0 to Length(FAliasNameMap) - 1 do
3018	+	if FAliasNameMap[i] = aliasName then
3019	+	begin
3020	+	Result := FieldDefs[i];
3021	+	Exit
3022	+	end;
3023	+	end;
3024	+
3025		function TIBCustomDataSet.GetFieldClass(FieldType: TFieldType): TFieldClass;
3026		begin
3027		Result := DefaultFieldClasses[FieldType];
#	Line 2603 | Line 3062 | begin
3062		Data := Buff + CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs;
3063		if (fdDataType = SQL_VARYING) or (fdDataType = SQL_TEXT) then
3064		begin
3065	<	if fdDataLength <= Field.Size then
3065	>	if fdDataLength < Field.DataSize then
3066		begin
3067		Move(Data^, Buffer^, fdDataLength);
3068		PChar(Buffer)[fdDataLength] := #0;
#	Line 2652 | Line 3111 | begin
3111		if not Accept and (GetMode = gmCurrent) then
3112		GetMode := gmPrior;
3113		except
3114	<	//        Application.HandleException(Self);
3114	>	//        FBase.HandleException(Self);
3115		end;
3116		end;
3117		RestoreState(SaveState);
#	Line 2746 | Line 3205 | begin
3205		result := FRecordBufferSize;
3206		end;
3207
3208	+	procedure TIBCustomDataSet.InternalAutoCommit;
3209	+	begin
3210	+	with Transaction do
3211	+	if InTransaction and (FAutoCommit = acCommitRetaining) then
3212	+	begin
3213	+	if CachedUpdates then ApplyUpdates;
3214	+	CommitRetaining;
3215	+	end;
3216	+	end;
3217	+
3218		procedure TIBCustomDataSet.InternalAddRecord(Buffer: Pointer; Append: Boolean);
3219		begin
3220		CheckEditState;
#	Line 2817 | Line 3286 | begin
3286		FreeMem(FOldBufferCache);
3287		FOldBufferCache := nil;
3288		BindFields(False);
3289	+	ResetParser;
3290		if DefaultFields then DestroyFields;
3291		end;
3292
3293		procedure TIBCustomDataSet.InternalDelete;
3294		var
3295		Buff: PChar;
2826	–	SetCursor: Boolean;
3296		begin
3297	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
2829	<	if SetCursor then
2830	<	Screen.Cursor := crHourGlass;
3297	>	FBase.SetCursor;
3298		try
3299		Buff := GetActiveBuf;
3300		if CanDelete then
#	Line 2852 | Line 3319 | begin
3319		end else
3320		IBError(ibxeCannotDelete, [nil]);
3321		finally
3322	<	if SetCursor and (Screen.Cursor = crHourGlass) then
2856	<	Screen.Cursor := crDefault;
3322	>	FBase.RestoreCursor;
3323		end;
3324		end;
3325
#	Line 2869 | Line 3335 | end;
3335
3336		procedure TIBCustomDataSet.InternalHandleException;
3337		begin
3338	<	Application.HandleException(Self)
3338	>	FBase.HandleException(Self)
3339		end;
3340
3341		procedure TIBCustomDataSet.InternalInitFieldDefs;
3342	+	begin
3343	+	if not InternalPrepared then
3344	+	begin
3345	+	InternalPrepare;
3346	+	exit;
3347	+	end;
3348	+	FieldDefsFromQuery(FQSelect);
3349	+	end;
3350	+
3351	+	procedure TIBCustomDataSet.FieldDefsFromQuery(SourceQuery: TIBSQL);
3352		const
3353		DefaultSQL = 'Select F.RDB$COMPUTED_BLR, ' + {do not localize}
3354		'F.RDB$DEFAULT_VALUE, R.RDB$FIELD_NAME ' + {do not localize}
#	Line 2884 | Line 3360 | const
3360		var
3361		FieldType: TFieldType;
3362		FieldSize: Word;
3363	+	charSetID: short;
3364	+	CharSetSize: integer;
3365	+	CharSetName: string;
3366		FieldNullable : Boolean;
3367		i, FieldPosition, FieldPrecision: Integer;
3368	<	FieldAliasName: string;
3368	>	FieldAliasName, DBAliasName: string;
3369		RelationName, FieldName: string;
3370		Query : TIBSQL;
3371		FieldIndex: Integer;
#	Line 2986 | Line 3465 | var
3465		end;
3466
3467		begin
2989	–	if not InternalPrepared then
2990	–	begin
2991	–	InternalPrepare;
2992	–	exit;
2993	–	end;
3468		FRelationNodes := TRelationNode.Create;
3469		FNeedsRefresh := False;
3470		Database.InternalTransaction.StartTransaction;
#	Line 3001 | Line 3475 | begin
3475		FieldDefs.BeginUpdate;
3476		FieldDefs.Clear;
3477		FieldIndex := 0;
3478	<	if (Length(FMappedFieldPosition) < FQSelect.Current.Count) then
3479	<	SetLength(FMappedFieldPosition, FQSelect.Current.Count);
3478	>	if (Length(FMappedFieldPosition) < SourceQuery.Current.Count) then
3479	>	SetLength(FMappedFieldPosition, SourceQuery.Current.Count);
3480		Query.SQL.Text := DefaultSQL;
3481		Query.Prepare;
3482	<	for i := 0 to FQSelect.Current.Count - 1 do
3483	<	with FQSelect.Current[i].Data^ do
3482	>	SetLength(FAliasNameMap, SourceQuery.Current.Count);
3483	>	SetLength(FAliasNameList, SourceQuery.Current.Count);
3484	>	for i := 0 to SourceQuery.Current.Count - 1 do
3485	>	with SourceQuery.Current[i].Data^ do
3486		begin
3487		{ Get the field name }
3488	<	SetString(FieldAliasName, aliasname, aliasname_length);
3488	>	FieldAliasName := SourceQuery.Current[i].Name;
3489	>	SetString(DBAliasName, aliasname, aliasname_length);
3490		SetString(RelationName, relname, relname_length);
3491		SetString(FieldName, sqlname, sqlname_length);
3492	+	FAliasNameList[i] := DBAliasName;
3493		FieldSize := 0;
3494		FieldPrecision := 0;
3495	<	FieldNullable := FQSelect.Current[i].IsNullable;
3495	>	FieldNullable := SourceQuery.Current[i].IsNullable;
3496	>	CharSetSize := 0;
3497	>	CharSetName := '';
3498		case sqltype and not 1 of
3499		{ All VARCHAR's must be converted to strings before recording
3500		their values }
3501		SQL_VARYING, SQL_TEXT:
3502		begin
3503	+	CharSetSize := FBase.GetCharSetSize(sqlsubtype and $FF);
3504	+	CharSetName := FBase.GetCharSetName(sqlsubtype and $FF);
3505	+	{FieldSize is encoded for strings - see TIBStringField.SetSize for decode}
3506		FieldSize := sqllen;
3507	<	FieldType := ftString;
3507	>	if CharSetSize = 2 then
3508	>	FieldType := ftWideString
3509	>	else
3510	>	FieldType := ftString;
3511		end;
3512		{ All Doubles/Floats should be cast to doubles }
3513		SQL_DOUBLE, SQL_FLOAT:
#	Line 3080 | Line 3566 | begin
3566		begin
3567		FieldSize := sizeof (TISC_QUAD);
3568		if (sqlsubtype = 1) then
3569	<	FieldType := ftmemo
3569	>	begin
3570	>	if strpas(sqlname) = '' then {Complex SQL with no identifiable column - use connection default}
3571	>	begin
3572	>	CharSetSize := FBase.GetDefaultCharSetSize;
3573	>	CharSetName := FBase.GetDefaultCharSetName;
3574	>	end
3575	>	else
3576	>	begin
3577	>	charSetID := GetBlobCharSetID(Database.Handle,Database.InternalTransaction.Handle,
3578	>	@relname,@sqlname);
3579	>	CharSetSize := FBase.GetCharSetSize(charSetID);
3580	>	CharSetName := FBase.GetCharSetName(charSetID);
3581	>	end;
3582	>	if CharSetSize = 2 then
3583	>	FieldType := ftWideMemo
3584	>	else
3585	>	FieldType := ftMemo;
3586	>	end
3587		else
3588		FieldType := ftBlob;
3589		end;
#	Line 3089 | Line 3592 | begin
3592		FieldSize := sizeof (TISC_QUAD);
3593		FieldType := ftUnknown;
3594		end;
3595	+	SQL_BOOLEAN:
3596	+	FieldType:= ftBoolean;
3597		else
3598		FieldType := ftUnknown;
3599		end;
#	Line 3097 | Line 3602 | begin
3602		begin
3603		FMappedFieldPosition[FieldIndex] := FieldPosition;
3604		Inc(FieldIndex);
3605	<	with FieldDefs.AddFieldDef do
3605	>	with TIBFieldDef.Create(FieldDefs,'',FieldType,0,False,FieldDefs.Count+1) do
3606		begin
3607		Name := FieldAliasName;
3608	<	(*           FieldNo := FieldPosition;*)
3104	<	DataType := FieldType;
3608	>	FAliasNameMap[FieldNo-1] := DBAliasName;
3609		Size := FieldSize;
3610		Precision := FieldPrecision;
3611		Required := not FieldNullable;
3612		InternalCalcField := False;
3613	+	CharacterSetSize := CharSetSize;
3614	+	CharacterSetName := CharSetName;
3615		if (FieldName <> '') and (RelationName <> '') then
3616		begin
3617		if Has_COMPUTED_BLR(RelationName, FieldName) then
#	Line 3185 | Line 3691 | begin
3691		else case cur_field.DataType of
3692		ftString:
3693		cur_param.AsString := cur_field.AsString;
3694	<	ftBoolean, ftSmallint, ftWord:
3694	>	ftBoolean:
3695	>	cur_param.AsBoolean := cur_field.AsBoolean;
3696	>	ftSmallint, ftWord:
3697		cur_param.AsShort := cur_field.AsInteger;
3698		ftInteger:
3699		cur_param.AsLong := cur_field.AsInteger;
#	Line 3238 | Line 3746 | begin
3746		end;
3747
3748		procedure TIBCustomDataSet.InternalOpen;
3241	–	var
3242	–	SetCursor: Boolean;
3749
3750		function RecordDataLength(n: Integer): Long;
3751		begin
3752		result := SizeOf(TRecordData) + ((n - 1) * SizeOf(TFieldData));
3753		end;
3754
3755	+	function GetFieldDef(aFieldNo: integer): TIBFieldDef;
3756	+	var i: integer;
3757	+	begin
3758	+	Result := nil;
3759	+	for i := 0 to FieldDefs.Count - 1 do
3760	+	if FieldDefs[i].FieldNo = aFieldNo then
3761	+	begin
3762	+	Result := TIBFieldDef(FieldDefs[i]);
3763	+	break;
3764	+	end;
3765	+	end;
3766	+
3767	+	procedure SetExtendedProperties;
3768	+	var i: integer;
3769	+	IBFieldDef: TIBFieldDef;
3770	+	begin
3771	+	for i := 0 to Fields.Count - 1 do
3772	+	if Fields[i].FieldNo > 0 then
3773	+	begin
3774	+	if(Fields[i] is TIBStringField) then
3775	+	with TIBStringField(Fields[i]) do
3776	+	begin
3777	+	IBFieldDef := GetFieldDef(FieldNo);
3778	+	if IBFieldDef <> nil then
3779	+	begin
3780	+	CharacterSetSize := IBFieldDef.CharacterSetSize;
3781	+	CharacterSetName := IBFieldDef.CharacterSetName;
3782	+	end;
3783	+	end
3784	+	else
3785	+	if(Fields[i] is TIBWideStringField) then
3786	+	with TIBWideStringField(Fields[i]) do
3787	+	begin
3788	+	IBFieldDef := GetFieldDef(FieldNo);
3789	+	if IBFieldDef <> nil then
3790	+	begin
3791	+	CharacterSetSize := IBFieldDef.CharacterSetSize;
3792	+	CharacterSetName := IBFieldDef.CharacterSetName;
3793	+	end;
3794	+	end
3795	+	else
3796	+	if(Fields[i] is TIBMemoField) then
3797	+	with TIBMemoField(Fields[i]) do
3798	+	begin
3799	+	IBFieldDef := GetFieldDef(FieldNo);
3800	+	if IBFieldDef <> nil then
3801	+	begin
3802	+	CharacterSetSize := IBFieldDef.CharacterSetSize;
3803	+	CharacterSetName := IBFieldDef.CharacterSetName;
3804	+	end;
3805	+	end
3806	+	else
3807	+	if(Fields[i] is TIBWideMemoField) then
3808	+	with TIBWideMemoField(Fields[i]) do
3809	+	begin
3810	+	IBFieldDef := GetFieldDef(FieldNo);
3811	+	if IBFieldDef <> nil then
3812	+	begin
3813	+	CharacterSetSize := IBFieldDef.CharacterSetSize;
3814	+	CharacterSetName := IBFieldDef.CharacterSetName;
3815	+	end;
3816	+	end
3817	+	end
3818	+	end;
3819	+
3820		begin
3821	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3251	<	if SetCursor then
3252	<	Screen.Cursor := crHourGlass;
3821	>	FBase.SetCursor;
3822		try
3823		ActivateConnection;
3824		ActivateTransaction;
#	Line 3262 | Line 3831 | begin
3831		if DefaultFields then
3832		CreateFields;
3833		BindFields(True);
3834	+	SetExtendedProperties;
3835		FCurrentRecord := -1;
3836		FQSelect.ExecQuery;
3837		FOpen := FQSelect.Open;
#	Line 3310 | Line 3880 | begin
3880		else
3881		FQSelect.ExecQuery;
3882		finally
3883	<	if SetCursor and (Screen.Cursor = crHourGlass) then
3314	<	Screen.Cursor := crDefault;
3883	>	FBase.RestoreCursor;
3884		end;
3885		end;
3886
#	Line 3319 | Line 3888 | procedure TIBCustomDataSet.InternalPost;
3888		var
3889		Qry: TIBSQL;
3890		Buff: PChar;
3322	–	SetCursor: Boolean;
3891		bInserting: Boolean;
3892		begin
3893	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3326	<	if SetCursor then
3327	<	Screen.Cursor := crHourGlass;
3893	>	FBase.SetCursor;
3894		try
3895		Buff := GetActiveBuf;
3896		CheckEditState;
#	Line 3362 | Line 3928 | begin
3928		if bInserting then
3929		Inc(FRecordCount);
3930		finally
3931	<	if SetCursor and (Screen.Cursor = crHourGlass) then
3366	<	Screen.Cursor := crDefault;
3931	>	FBase.RestoreCursor;
3932		end;
3933		end;
3934
#	Line 3383 | Line 3948 | begin
3948		result := FOpen;
3949		end;
3950
3951	+	procedure TIBCustomDataSet.Loaded;
3952	+	begin
3953	+	if assigned(FQSelect) then
3954	+	FBaseSQLSelect.assign(FQSelect.SQL);
3955	+	inherited Loaded;
3956	+	end;
3957	+
3958	+	procedure TIBCustomDataSet.Post;
3959	+	var CancelPost: boolean;
3960	+	begin
3961	+	CancelPost := false;
3962	+	if assigned(FOnValidatePost) then
3963	+	OnValidatePost(self,CancelPost);
3964	+	if CancelPost then
3965	+	Cancel
3966	+	else
3967	+	inherited Post;
3968	+	end;
3969	+
3970		function TIBCustomDataSet.Locate(const KeyFields: string; const KeyValues: Variant;
3971		Options: TLocateOptions): Boolean;
3972		var
3973	<	{$IF FPC_FULLVERSION > 20600 }
3973	>	{$IF FPC_FULLVERSION >= 20700 }
3974		CurBookmark: TBookmark;
3975		{$ELSE}
3976		CurBookmark: string;
#	Line 3408 | Line 3992 | function TIBCustomDataSet.Lookup(const K
3992		const ResultFields: string): Variant;
3993		var
3994		fl: TList;
3995	<	{$IF FPC_FULLVERSION > 20600 }
3995	>	{$IF FPC_FULLVERSION >= 20700 }
3996		CurBookmark: TBookmark;
3997		{$ELSE}
3998		CurBookmark: string;
#	Line 3465 | Line 4049 | end;
4049		procedure TIBCustomDataSet.InternalSetFieldData(Field: TField; Buffer: Pointer);
4050		var
4051		Buff, TmpBuff: PChar;
4052	+	MappedFieldPos: integer;
4053		begin
4054		Buff := GetActiveBuf;
4055		if Field.FieldNo < 0 then
#	Line 3481 | Line 4066 | begin
4066		begin
4067		{ If inserting, Adjust record position }
4068		AdjustRecordOnInsert(Buff);
4069	<	if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and
4070	<	(FMappedFieldPosition[Field.FieldNo - 1] <= rdFieldCount) then
4069	>	MappedFieldPos := FMappedFieldPosition[Field.FieldNo - 1];
4070	>	if (MappedFieldPos > 0) and
4071	>	(MappedFieldPos <= rdFieldCount) then
4072		begin
4073		Field.Validate(Buffer);
4074		if (Buffer = nil) or
4075		(Field is TIBStringField) and (PChar(Buffer)[0] = #0) then
4076	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull := True
4076	>	rdFields[MappedFieldPos].fdIsNull := True
4077		else begin
4078	<	Move(Buffer^, Buff[rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs],
4079	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataSize);
4080	<	if (rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_TEXT) or
4081	<	(rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_VARYING) then
4082	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataLength := StrLen(PChar(Buffer));
4083	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull := False;
4078	>	Move(Buffer^, Buff[rdFields[MappedFieldPos].fdDataOfs],
4079	>	rdFields[MappedFieldPos].fdDataSize);
4080	>	if (rdFields[MappedFieldPos].fdDataType = SQL_TEXT) or
4081	>	(rdFields[MappedFieldPos].fdDataType = SQL_VARYING) then
4082	>	rdFields[MappedFieldPos].fdDataLength := StrLen(PChar(Buffer));
4083	>	rdFields[MappedFieldPos].fdIsNull := False;
4084		if rdUpdateStatus = usUnmodified then
4085		begin
4086		if CachedUpdates then
#	Line 3582 | Line 4168 | begin
4168		FillChar(Buffer[FRecordSize], CalcFieldsSize, 0);
4169		end;
4170
4171	+	procedure TIBCustomDataSet.ClearIBLinks;
4172	+	var i: integer;
4173	+	begin
4174	+	for i := FIBLinks.Count - 1 downto 0 do
4175	+	TIBControlLink(FIBLinks[i]).IBDataSet := nil;
4176	+	end;
4177	+
4178
4179		procedure TIBCustomDataSet.InternalUnPrepare;
4180		begin
#	Line 3589 | Line 4182 | begin
4182		begin
4183		CheckDatasetClosed;
4184		FieldDefs.Clear;
4185	+	FieldDefs.Updated := false;
4186		FInternalPrepared := False;
4187	+	Setlength(FAliasNameList,0);
4188		end;
4189		end;
4190
4191		procedure TIBCustomDataSet.InternalExecQuery;
4192		var
4193		DidActivate: Boolean;
3599	–	SetCursor: Boolean;
4194		begin
4195		DidActivate := False;
4196	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3603	<	if SetCursor then
3604	<	Screen.Cursor := crHourGlass;
4196	>	FBase.SetCursor;
4197		try
4198		ActivateConnection;
4199		DidActivate := ActivateTransaction;
#	Line 3618 | Line 4210 | begin
4210		finally
4211		if DidActivate then
4212		DeactivateTransaction;
4213	<	if SetCursor and (Screen.Cursor = crHourGlass) then
3622	<	Screen.Cursor := crDefault;
4213	>	FBase.RestoreCursor;
4214		end;
4215		end;
4216
#	Line 3628 | Line 4219 | begin
4219		Result := FQSelect.Handle;
4220		end;
4221
4222	+	function TIBCustomDataSet.GetParser: TSelectSQLParser;
4223	+	begin
4224	+	if not assigned(FParser) then
4225	+	FParser := CreateParser;
4226	+	Result := FParser
4227	+	end;
4228	+
4229	+	procedure TIBCustomDataSet.ResetParser;
4230	+	begin
4231	+	if assigned(FParser) then
4232	+	begin
4233	+	FParser.Free;
4234	+	FParser := nil;
4235	+	FQSelect.OnSQLChanged := nil; {Do not react to change}
4236	+	try
4237	+	FQSelect.SQL.Assign(FBaseSQLSelect);
4238	+	finally
4239	+	FQSelect.OnSQLChanged := SQLChanged;
4240	+	end;
4241	+	end;
4242	+	end;
4243	+
4244	+	function TIBCustomDataSet.HasParser: boolean;
4245	+	begin
4246	+	Result := not (csDesigning in ComponentState) and (FParser <> nil)
4247	+	end;
4248	+
4249	+	procedure TIBCustomDataSet.SetGenerateParamNames(AValue: Boolean);
4250	+	begin
4251	+	if FGenerateParamNames = AValue then Exit;
4252	+	FGenerateParamNames := AValue;
4253	+	Disconnect
4254	+	end;
4255	+
4256		procedure TIBCustomDataSet.InitRecord(Buffer: PChar);
4257		begin
4258		inherited InitRecord(Buffer);
#	Line 3962 | Line 4587 | begin
4587		FBlobStream.Truncate;
4588		end;
4589
4590	+	destructor TIBDSBlobStream.Destroy;
4591	+	begin
4592	+	if FHasWritten then
4593	+	TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
4594	+	inherited Destroy;
4595	+	end;
4596	+
4597		function TIBDSBlobStream.Read(var Buffer; Count: Longint): Longint;
4598		begin
4599		result := FBlobStream.Read(Buffer, Count);
#	Line 3984 | Line 4616 | begin
4616		TIBCustomDataSet(FField.DataSet).RecordModified(True);
4617		TBlobField(FField).Modified := true;
4618		result := FBlobStream.Write(Buffer, Count);
4619	<	TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
4619	>	FHasWritten := true;
4620	>	{  TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
4621	>	Removed as this caused a seek to beginning of the blob stream thus corrupting
4622	>	the blob stream. Moved to the destructor i.e. called after blob written}
4623		end;
4624
4625		{ TIBGenerator }
#	Line 4031 | Line 4666 | end;
4666
4667		procedure TIBGenerator.Apply;
4668		begin
4669	<	if (FGeneratorName <> '') and (FFieldName <> '')  then
4669	>	if (FGeneratorName <> '') and (FFieldName <> '') and Owner.FieldByName(FFieldName).IsNull then
4670		Owner.FieldByName(FFieldName).AsInteger := GetNextValue(Owner.Database,Owner.Transaction);
4671		end;
4672
4673	+
4674		end.

Diff Legend

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