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 11 by tony, Tue Oct 9 08:10:32 2012 UTC vs.
Revision 41 by tony, Sat Jul 16 12:25:48 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	+	{$IF FPC_FULLVERSION >= 20700 }
37	+	{$codepage UTF8}
38	+	{$DEFINE HAS_ANSISTRING_CODEPAGE}
39	+	{$DEFINE NEW_TBOOKMARK}
40	+	{$ENDIF}
41	+
42	+	{$R-}
43	+
44		{$Mode Delphi}
45
46		{$IFDEF DELPHI}
#	Line 47 | Line 55 | uses
55		{$ELSE}
56		unix,
57		{$ENDIF}
58	<	SysUtils, Classes, Forms, Controls, IBDatabase,
59	<	IBExternals, IB, IBHeader,  IBSQL, Db,
52	<	IBUtils, IBBlob;
58	>	SysUtils, Classes, IBDatabase, IBExternals, IB, IBHeader,  IBSQL, Db,
59	>	IBUtils, IBBlob, IBSQLParser;
60
61		const
62		BufferCacheSize    =  1000;  { Allocate cache in this many record chunks}
#	Line 118 | Line 125 | type
125		{ TIBStringField allows us to have strings longer than 8196 }
126
127		TIBStringField = class(TStringField)
128	+	private
129	+	FCharacterSetName: RawByteString;
130	+	FCharacterSetSize: integer;
131	+	protected
132	+	function GetDefaultWidth: Longint; override;
133		public
134	<	constructor create(AOwner: TComponent); override;
134	>	constructor Create(aOwner: TComponent); override;
135		class procedure CheckTypeSize(Value: Integer); override;
136		function GetAsString: string; override;
137		function GetAsVariant: Variant; override;
138		function GetValue(var Value: string): Boolean;
139		procedure SetAsString(const Value: string); override;
140	+	property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
141	+	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
142	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
143	+	private
144	+	FCodePage: TSystemCodePage;
145	+	public
146	+	property CodePage: TSystemCodePage read FCodePage write FCodePage;
147	+	{$ENDIF}
148	+	end;
149	+
150	+	{ TIBWideStringField }
151	+
152	+	TIBWideStringField = class(TWideStringField)
153	+	private
154	+	FCharacterSetName: RawByteString;
155	+	FCharacterSetSize: integer;
156	+	public
157	+	property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
158	+	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
159		end;
160
161		{ TIBBCDField }
#	Line 147 | Line 178 | type
178		property Size default 8;
179		end;
180
181	+	{TIBMemoField}
182	+	{Allows us to show truncated text in DBGrids and anything else that uses
183	+	DisplayText}
184	+
185	+	TIBMemoField = class(TMemoField)
186	+	private
187	+	FCharacterSetName: RawByteString;
188	+	FCharacterSetSize: integer;
189	+	FDisplayTextAsClassName: boolean;
190	+	function GetTruncatedText: string;
191	+	protected
192	+	function GetAsString: string; override;
193	+	function GetDefaultWidth: Longint; override;
194	+	procedure GetText(var AText: string; ADisplayText: Boolean); override;
195	+	procedure SetAsString(const AValue: string); override;
196	+	public
197	+	constructor Create(AOwner: TComponent); override;
198	+	property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
199	+	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
200	+	published
201	+	property DisplayTextAsClassName: boolean read FDisplayTextAsClassName
202	+	write FDisplayTextAsClassName;
203	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
204	+	private
205	+	FCodePage: TSystemCodePage;
206	+	FFCodePage: TSystemCodePage;
207	+	public
208	+	property CodePage: TSystemCodePage read FFCodePage write FFCodePage;
209	+	{$ENDIF}
210	+	end;
211	+
212	+	{ TIBWideMemoField }
213	+
214	+	TIBWideMemoField = class(TWideMemoField)
215	+	private
216	+	FCharacterSetName: RawByteString;
217	+	FCharacterSetSize: integer;
218	+	FDisplayTextAsClassName: boolean;
219	+	function GetTruncatedText: string;
220	+	protected
221	+	function GetDefaultWidth: Longint; override;
222	+	procedure GetText(var AText: string; ADisplayText: Boolean); override;
223	+	public
224	+	constructor Create(AOwner: TComponent); override;
225	+	property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
226	+	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
227	+	published
228	+	property DisplayTextAsClassName: boolean read FDisplayTextAsClassName
229	+	write FDisplayTextAsClassName;
230	+	end;
231	+
232		TIBDataLink = class(TDetailDataLink)
233		private
234		FDataSet: TIBCustomDataSet;
#	Line 185 | Line 267 | type
267		property ApplyOnEvent: TIBGeneratorApplyOnEvent read FApplyOnEvent write FApplyOnEvent;
268		end;
269
270	+	{TIBControlLink - Allows IB Aware controls to react to dataset state changes}
271	+
272	+	TIBControlLink = class
273	+	private
274	+	FTIBDataSet: TIBCustomDataSet;
275	+	procedure SetIBDataSet(AValue: TIBCustomDataSet);
276	+	protected
277	+	procedure UpdateSQL(Sender: TObject); virtual;
278	+	procedure UpdateParams(Sender: TObject); virtual;
279	+	public
280	+	destructor Destroy; override;
281	+	property IBDataSet: TIBCustomDataSet read FTIBDataSet write SetIBDataSet;
282	+	end;
283	+
284	+	TIBAutoCommit = (acDisabled, acCommitRetaining);
285	+
286		{ TIBCustomDataSet }
287		TIBUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApply, uaApplied);
288
289		TIBUpdateErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
290	<	UpdateKind: TUpdateKind; var UpdateAction: TIBUpdateAction)
290	>	UpdateKind: TUpdateKind; var TheUpdateAction: TIBUpdateAction)
291		of object;
292		TIBUpdateRecordEvent = procedure(DataSet: TDataSet; UpdateKind: TUpdateKind;
293		var UpdateAction: TIBUpdateAction) of object;
294
295		TIBUpdateRecordTypes = set of TCachedUpdateStatus;
296
297	+	TDataSetCloseAction = (dcDiscardChanges, dcSaveChanges);
298	+
299	+	TOnValidatePost = procedure (Sender: TObject; var CancelPost: boolean) of object;
300	+
301		TIBCustomDataSet = class(TDataset)
302		private
303	+	FAutoCommit: TIBAutoCommit;
304	+	FGenerateParamNames: Boolean;
305		FGeneratorField: TIBGenerator;
306		FNeedsRefresh: Boolean;
307		FForcedRefresh: Boolean;
#	Line 223 | Line 327 | type
327		FDeletedRecords: Long;
328		FModelBuffer,
329		FOldBuffer: PChar;
330	+	FOnValidatePost: TOnValidatePost;
331		FOpen: Boolean;
332		FInternalPrepared: Boolean;
333		FQDelete,
#	Line 233 | Line 338 | type
338		FRecordBufferSize: Integer;
339		FRecordCount: Integer;
340		FRecordSize: Integer;
341	+	FDataSetCloseAction: TDataSetCloseAction;
342		FUniDirectional: Boolean;
343		FUpdateMode: TUpdateMode;
344		FUpdateObject: TIBDataSetUpdateObject;
#	Line 250 | Line 356 | type
356		FBeforeTransactionEnd,
357		FAfterTransactionEnd,
358		FTransactionFree: TNotifyEvent;
359	<
359	>	FAliasNameMap: array of string;
360	>	FAliasNameList: array of string;
361	>	FBaseSQLSelect: TStrings;
362	>	FParser: TSelectSQLParser;
363	>	FCloseAction: TTransactionAction;
364	>	FInTransactionEnd: boolean;
365	>	FIBLinks: TList;
366		function GetSelectStmtHandle: TISC_STMT_HANDLE;
367		procedure SetUpdateMode(const Value: TUpdateMode);
368		procedure SetUpdateObject(Value: TIBDataSetUpdateObject);
#	Line 263 | Line 375 | type
375		function CanRefresh: Boolean;
376		procedure CheckEditState;
377		procedure ClearBlobCache;
378	+	procedure ClearIBLinks;
379		procedure CopyRecordBuffer(Source, Dest: Pointer);
380		procedure DoBeforeDatabaseDisconnect(Sender: TObject);
381		procedure DoAfterDatabaseDisconnect(Sender: TObject);
382		procedure DoDatabaseFree(Sender: TObject);
383	<	procedure DoBeforeTransactionEnd(Sender: TObject);
383	>	procedure DoBeforeTransactionEnd(Sender: TObject; Action: TTransactionAction);
384		procedure DoAfterTransactionEnd(Sender: TObject);
385		procedure DoTransactionFree(Sender: TObject);
386		procedure FetchCurrentRecordToBuffer(Qry: TIBSQL; RecordNumber: Integer;
#	Line 283 | Line 396 | type
396		function GetModifySQL: TStrings;
397		function GetTransaction: TIBTransaction;
398		function GetTRHandle: PISC_TR_HANDLE;
399	+	function GetParser: TSelectSQLParser;
400		procedure InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer); virtual;
401		function InternalLocate(const KeyFields: string; const KeyValues: Variant;
402		Options: TLocateOptions): Boolean; virtual;
403		procedure InternalPostRecord(Qry: TIBSQL; Buff: Pointer); virtual;
404		procedure InternalRevertRecord(RecordNumber: Integer); virtual;
405		function IsVisible(Buffer: PChar): Boolean;
406	+	procedure RegisterIBLink(Sender: TIBControlLink);
407	+	procedure UnRegisterIBLink(Sender: TIBControlLink);
408		procedure SaveOldBuffer(Buffer: PChar);
409		procedure SetBufferChunks(Value: Integer);
410		procedure SetDatabase(Value: TIBDatabase);
#	Line 302 | Line 418 | type
418		procedure SetUpdateRecordTypes(Value: TIBUpdateRecordTypes);
419		procedure SetUniDirectional(Value: Boolean);
420		procedure RefreshParams;
305	–	procedure SQLChanging(Sender: TObject); virtual;
421		function AdjustPosition(FCache: PChar; Offset: DWORD;
422		Origin: Integer): DWORD;
423		procedure ReadCache(FCache: PChar; Offset: DWORD; Origin: Integer;
#	Line 321 | Line 436 | type
436		procedure DeactivateTransaction;
437		procedure CheckDatasetClosed;
438		procedure CheckDatasetOpen;
439	+	function CreateParser: TSelectSQLParser; virtual;
440	+	procedure FieldDefsFromQuery(SourceQuery: TIBSQL);
441		function GetActiveBuf: PChar;
442		procedure InternalBatchInput(InputObject: TIBBatchInput); virtual;
443		procedure InternalBatchOutput(OutputObject: TIBBatchOutput); virtual;
#	Line 330 | Line 447 | type
447		procedure InternalRefreshRow; virtual;
448		procedure InternalSetParamsFromCursor; virtual;
449		procedure CheckNotUniDirectional;
450	+	procedure SQLChanging(Sender: TObject); virtual;
451	+	procedure SQLChanged(Sender: TObject); virtual;
452
453		(*    { IProviderSupport }
454		procedure PSEndTransaction(Commit: Boolean); override;
#	Line 353 | Line 472 | type
472		procedure ClearCalcFields(Buffer: PChar); override;
473		function AllocRecordBuffer: PChar; override;
474		procedure DoBeforeDelete; override;
475	+	procedure DoAfterDelete; override;
476		procedure DoBeforeEdit; override;
477	+	procedure DoAfterEdit; override;
478		procedure DoBeforeInsert; override;
479		procedure DoAfterInsert; override;
480	+	procedure DoBeforeClose; override;
481	+	procedure DoBeforeOpen; override;
482		procedure DoBeforePost; override;
483	+	procedure DoAfterPost; override;
484		procedure FreeRecordBuffer(var Buffer: PChar); override;
485		procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
486		function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
487		function GetCanModify: Boolean; override;
488		function GetDataSource: TDataSource; override;
489	+	function GetDBAliasName(FieldNo: integer): string;
490	+	function GetFieldDefFromAlias(aliasName: string): TFieldDef;
491		function GetFieldClass(FieldType: TFieldType): TFieldClass; override;
492		function GetRecNo: Integer; override;
493		function GetRecord(Buffer: PChar; GetMode: TGetMode;
494		DoCheck: Boolean): TGetResult; override;
495		function GetRecordCount: Integer; override;
496		function GetRecordSize: Word; override;
497	+	procedure InternalAutoCommit;
498		procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override;
499		procedure InternalCancel; override;
500		procedure InternalClose; override;
#	Line 385 | Line 512 | type
512		procedure InternalSetFieldData(Field: TField; Buffer: Pointer); virtual;
513		procedure InternalSetToRecord(Buffer: PChar); override;
514		function IsCursorOpen: Boolean; override;
515	+	procedure Loaded; override;
516		procedure ReQuery;
517		procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
518		procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
519		procedure SetCachedUpdates(Value: Boolean);
520		procedure SetDataSource(Value: TDataSource);
521	+	procedure SetGenerateParamNames(AValue: Boolean); virtual;
522		procedure SetFieldData(Field : TField; Buffer : Pointer); override;
523		procedure SetFieldData(Field : TField; Buffer : Pointer;
524		NativeFormat : Boolean); overload; override;
#	Line 397 | Line 526 | type
526
527		protected
528		{Likely to be made public by descendant classes}
529	+	property AutoCommit: TIBAutoCommit read FAutoCommit write FAutoCommit default acDisabled;
530		property SQLParams: TIBXSQLDA read GetSQLParams;
531		property Params: TIBXSQLDA read GetSQLParams;
532		property InternalPrepared: Boolean read FInternalPrepared;
#	Line 420 | Line 550 | type
550		property ModifySQL: TStrings read GetModifySQL write SetModifySQL;
551		property UpdateMode: TUpdateMode read FUpdateMode write SetUpdateMode default upWhereAll;
552		property ParamCheck: Boolean read FParamCheck write FParamCheck default True;
553	+	property Parser: TSelectSQLParser read GetParser;
554	+	property BaseSQLSelect: TStrings read FBaseSQLSelect;
555
556		property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect
557		write FBeforeDatabaseDisconnect;
#	Line 433 | Line 565 | type
565		write FAfterTransactionEnd;
566		property TransactionFree: TNotifyEvent read FTransactionFree
567		write FTransactionFree;
568	+	property OnValidatePost: TOnValidatePost read FOnValidatePost write FOnValidatePost;
569
570		public
571		constructor Create(AOwner: TComponent); override;
#	Line 440 | Line 573 | type
573		procedure ApplyUpdates;
574		function CachedUpdateStatus: TCachedUpdateStatus;
575		procedure CancelUpdates;
576	+	function GetFieldPosition(AliasName: string): integer;
577		procedure FetchAll;
578		function LocateNext(const KeyFields: string; const KeyValues: Variant;
579		Options: TLocateOptions): Boolean;
580		procedure RecordModified(Value: Boolean);
581		procedure RevertRecord;
582		procedure Undelete;
583	+	procedure ResetParser; virtual;
584	+	function HasParser: boolean;
585
586		{ TDataSet support methods }
587		function BookmarkValid(Bookmark: TBookmark): Boolean; override;
#	Line 456 | Line 592 | type
592		function GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; overload; (*override;*)
593		function GetFieldData(Field : TField; Buffer : Pointer;
594		NativeFormat : Boolean) : Boolean; overload; override;
595	+	property GenerateParamNames: Boolean read FGenerateParamNames write SetGenerateParamNames;
596		function Locate(const KeyFields: string; const KeyValues: Variant;
597		Options: TLocateOptions): Boolean; override;
598		function Lookup(const KeyFields: string; const KeyValues: Variant;
599		const ResultFields: string): Variant; override;
600		function UpdateStatus: TUpdateStatus; override;
601		function IsSequenced: Boolean; override;
602	+	procedure Post; override;
603		function ParamByName(ParamName: String): TIBXSQLVAR;
604		property DBHandle: PISC_DB_HANDLE read GetDBHandle;
605		property TRHandle: PISC_TR_HANDLE read GetTRHandle;
#	Line 469 | Line 607 | type
607		property UpdatesPending: Boolean read FUpdatesPending;
608		property UpdateRecordTypes: TIBUpdateRecordTypes read FUpdateRecordTypes
609		write SetUpdateRecordTypes;
610	+	property DataSetCloseAction: TDataSetCloseAction
611	+	read FDataSetCloseAction write FDataSetCloseAction;
612
613		published
614		property Database: TIBDatabase read GetDatabase write SetDatabase;
#	Line 507 | Line 647 | type
647		write FOnUpdateRecord;
648		end;
649
650	<	TIBDataSet = class(TIBCustomDataSet)
650	>	TIBParserDataSet = class(TIBCustomDataSet)
651	>	public
652	>	property Parser;
653	>	end;
654	>
655	>	TIBDataSet = class(TIBParserDataSet)
656		private
657		function GetPrepared: Boolean;
658
#	Line 532 | Line 677 | type
677		property QModify;
678		property StatementType;
679		property SelectStmtHandle;
680	+	property BaseSQLSelect;
681
682		published
683		{ TIBCustomDataSet }
684	+	property AutoCommit;
685		property BufferChunks;
686		property CachedUpdates;
687		property DeleteSQL;
#	Line 543 | Line 690 | type
690		property SelectSQL;
691		property ModifySQL;
692		property GeneratorField;
693	+	property GenerateParamNames;
694		property ParamCheck;
695		property UniDirectional;
696		property Filtered;
697	+	property DataSetCloseAction;
698
699		property BeforeDatabaseDisconnect;
700		property AfterDatabaseDisconnect;
#	Line 581 | Line 730 | type
730		property OnFilterRecord;
731		property OnNewRecord;
732		property OnPostError;
733	+	property OnValidatePost;
734		end;
735
736		{ TIBDSBlobStream }
737		TIBDSBlobStream = class(TStream)
738	+	private
739	+	FHasWritten: boolean;
740		protected
741		FField: TField;
742		FBlobStream: TIBBlobStream;
743	+	function  GetSize: Int64; override;
744		public
745		constructor Create(AField: TField; ABlobStream: TIBBlobStream;
746		Mode: TBlobStreamMode);
747	+	destructor Destroy; override;
748		function Read(var Buffer; Count: Longint): Longint; override;
749		function Seek(Offset: Longint; Origin: Word): Longint; override;
750		procedure SetSize(NewSize: Longint); override;
#	Line 615 | Line 769 | DefaultFieldClasses: array[TFieldType] o
769		TVarBytesField,     { ftVarBytes }
770		TAutoIncField,      { ftAutoInc }
771		TBlobField,         { ftBlob }
772	<	TMemoField,         { ftMemo }
772	>	TIBMemoField,       { ftMemo }
773		TGraphicField,      { ftGraphic }
774		TBlobField,         { ftFmtMemo }
775		TBlobField,         { ftParadoxOle }
#	Line 623 | Line 777 | DefaultFieldClasses: array[TFieldType] o
777		TBlobField,         { ftTypedBinary }
778		nil,                { ftCursor }
779		TStringField,       { ftFixedChar }
780	<	TWideStringField,    { ftWideString }
780	>	TIBWideStringField,    { ftWideString }
781		TLargeIntField,     { ftLargeInt }
782		nil,          { ftADT }
783		nil,        { ftArray }
#	Line 638 | Line 792 | DefaultFieldClasses: array[TFieldType] o
792		TDateTimeField,    {ftTimestamp}
793		TIBBCDField,       {ftFMTBcd}
794		nil,  {ftFixedWideChar}
795	<	TWideMemoField);   {ftWideMemo}
795	>	TIBWideMemoField);   {ftWideMemo}
796		(*
797		TADTField,          { ftADT }
798		TArrayField,        { ftArray }
#	Line 655 | Line 809 | DefaultFieldClasses: array[TFieldType] o
809
810		implementation
811
812	<	uses IBIntf, Variants, FmtBCD;
812	>	uses IBIntf, Variants, FmtBCD, LazUTF8;
813
814		const FILE_BEGIN = 0;
815		FILE_CURRENT = 1;
#	Line 678 | Line 832 | type
832		NextRelation : TRelationNode;
833		end;
834
835	+	{Extended Field Def for character set info}
836
837	<	{ TIBStringField}
837	>	{ TIBFieldDef }
838	>
839	>	TIBFieldDef = class(TFieldDef)
840	>	private
841	>	FCharacterSetName: RawByteString;
842	>	FCharacterSetSize: integer;
843	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
844	>	FCodePage: TSystemCodePage;
845	>	{$ENDIF}
846	>	published
847	>	property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
848	>	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
849	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
850	>	property CodePage: TSystemCodePage read FCodePage write FCodePage;
851	>	{$ENDIF}
852	>	end;
853	>
854	>
855	>	{  Copied from LCLProc in order to avoid LCL dependency
856	>
857	>	Ensures the covenient look of multiline string
858	>	when displaying it in the single line
859	>	* Replaces CR and LF with spaces
860	>	* Removes duplicate spaces
861	>	}
862	>	function TextToSingleLine(const AText: string): string;
863	>	var
864	>	str: string;
865	>	i, wstart, wlen: Integer;
866	>	begin
867	>	str := Trim(AText);
868	>	wstart := 0;
869	>	wlen := 0;
870	>	i := 1;
871	>	while i < Length(str) - 1 do
872	>	begin
873	>	if (str[i] in [' ', #13, #10]) then
874	>	begin
875	>	if (wstart = 0) then
876	>	begin
877	>	wstart := i;
878	>	wlen := 1;
879	>	end else
880	>	Inc(wlen);
881	>	end else
882	>	begin
883	>	if wstart > 0 then
884	>	begin
885	>	str[wstart] := ' ';
886	>	Delete(str, wstart+1, wlen-1);
887	>	Dec(i, wlen-1);
888	>	wstart := 0;
889	>	end;
890	>	end;
891	>	Inc(i);
892	>	end;
893	>	Result := str;
894	>	end;
895	>
896	>	{ TIBWideMemoField }
897	>
898	>	function TIBWideMemoField.GetTruncatedText: string;
899	>	begin
900	>	Result := GetAsString;
901	>
902	>	if Result <> '' then
903	>	if DisplayWidth = 0 then
904	>	Result := TextToSingleLine(Result)
905	>	else
906	>	if Length(Result) > DisplayWidth then {Show truncation with elipses}
907	>	Result := TextToSingleLine(system.copy(Result,1,DisplayWidth-3)) + '...';
908	>	end;
909	>
910	>	function TIBWideMemoField.GetDefaultWidth: Longint;
911	>	begin
912	>	Result := 128;
913	>	end;
914	>
915	>	procedure TIBWideMemoField.GetText(var AText: string; ADisplayText: Boolean);
916	>	begin
917	>	if ADisplayText then
918	>	begin
919	>	if not DisplayTextAsClassName and (CharacterSetName<> '') then
920	>	AText := GetTruncatedText
921	>	else
922	>	inherited GetText(AText, ADisplayText);
923	>	end
924	>	else
925	>	AText := GetAsString;
926	>	end;
927	>
928	>	constructor TIBWideMemoField.Create(AOwner: TComponent);
929	>	begin
930	>	inherited Create(AOwner);
931	>	BlobType := ftWideMemo;
932	>	end;
933	>
934	>	{ TIBMemoField }
935	>
936	>	function TIBMemoField.GetTruncatedText: string;
937	>	begin
938	>	Result := GetAsString;
939	>
940	>	if Result <> '' then
941	>	begin
942	>	case CharacterSetSize of
943	>	1:
944	>	if DisplayWidth = 0 then
945	>	Result := TextToSingleLine(Result)
946	>	else
947	>	if Length(Result) > DisplayWidth then {Show truncation with elipses}
948	>	Result := TextToSingleLine(system.copy(Result,1,DisplayWidth-3)) + '...';
949	>
950	>	{2: case 2 ignored. This should be handled by TIBWideMemo}
951	>
952	>	3, {Assume UNICODE_FSS is really UTF8}
953	>	4: {Include GB18030 - assuming UTF8 routine work for this codeset}
954	>	if DisplayWidth = 0 then
955	>	Result := ValidUTF8String(TextToSingleLine(Result))
956	>	else
957	>	if UTF8Length(Result) > DisplayWidth then {Show truncation with elipses}
958	>	Result := ValidUTF8String(TextToSingleLine(UTF8Copy(Result,1,DisplayWidth-3))) + '...';
959	>	end;
960	>	end
961	>	end;
962	>
963	>	function TIBMemoField.GetAsString: string;
964	>	var s: RawByteString;
965	>	begin
966	>	s := inherited GetAsString;
967	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
968	>	SetCodePage(s,CodePage,false);
969	>	{$ENDIF}
970	>	Result := s;
971	>	end;
972	>
973	>	function TIBMemoField.GetDefaultWidth: Longint;
974	>	begin
975	>	if DisplayTextAsClassName then
976	>	Result := inherited
977	>	else
978	>	Result := 128;
979	>	end;
980
981	<	constructor TIBStringField.Create(AOwner: TComponent);
981	>	procedure TIBMemoField.GetText(var AText: string; ADisplayText: Boolean);
982	>	begin
983	>	if ADisplayText then
984	>	begin
985	>	if not DisplayTextAsClassName and (CharacterSetName <> '') then
986	>	AText := GetTruncatedText
987	>	else
988	>	inherited GetText(AText, ADisplayText);
989	>	end
990	>	else
991	>	AText := GetAsString;
992	>	end;
993	>
994	>	procedure TIBMemoField.SetAsString(const AValue: string);
995	>	var s: RawByteString;
996	>	begin
997	>	s := AValue;
998	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
999	>	if StringCodePage(Value) <> CodePage then
1000	>	SetCodePage(s,CodePage,true);
1001	>	{$ENDIF}
1002	>	inherited SetAsString(s);
1003	>	end;
1004	>
1005	>	constructor TIBMemoField.Create(AOwner: TComponent);
1006		begin
1007		inherited Create(AOwner);
1008	+	BlobType := ftMemo;
1009	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1010	+	FCodePage := CP_NONE;
1011	+	{$ENDIF}
1012	+	end;
1013	+
1014	+	{ TIBControlLink }
1015	+
1016	+	destructor TIBControlLink.Destroy;
1017	+	begin
1018	+	IBDataSet := nil;
1019	+	inherited Destroy;
1020	+	end;
1021	+
1022	+	procedure TIBControlLink.UpdateParams(Sender: TObject);
1023	+	begin
1024	+
1025	+	end;
1026	+
1027	+	procedure TIBControlLink.UpdateSQL(Sender: TObject);
1028	+	begin
1029	+
1030	+	end;
1031	+
1032	+	procedure TIBControlLink.SetIBDataSet(AValue: TIBCustomDataSet);
1033	+	begin
1034	+	if FTIBDataSet = AValue then Exit;
1035	+	if IBDataSet <> nil then
1036	+	IBDataSet.UnRegisterIBLink(self);
1037	+	FTIBDataSet := AValue;
1038	+	if IBDataSet <> nil then
1039	+	IBDataSet.RegisterIBLink(self);
1040	+	end;
1041	+
1042	+
1043	+	{ TIBStringField}
1044	+
1045	+	function TIBStringField.GetDefaultWidth: Longint;
1046	+	begin
1047	+	Result := Size div CharacterSetSize;
1048	+	end;
1049	+
1050	+	constructor TIBStringField.Create(aOwner: TComponent);
1051	+	begin
1052	+	inherited Create(aOwner);
1053	+	FCharacterSetSize := 1;
1054	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1055	+	FCodePage := CP_NONE;
1056	+	{$ENDIF}
1057		end;
1058
1059		class procedure TIBStringField.CheckTypeSize(Value: Integer);
#	Line 706 | Line 1076 | end;
1076		function TIBStringField.GetValue(var Value: string): Boolean;
1077		var
1078		Buffer: PChar;
1079	+	s: RawByteString;
1080		begin
1081		Buffer := nil;
1082		IBAlloc(Buffer, 0, Size + 1);
#	Line 713 | Line 1084 | begin
1084		Result := GetData(Buffer);
1085		if Result then
1086		begin
1087	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1088	+	s := string(Buffer);
1089	+	SetCodePage(s,CodePage,false);
1090	+	Value := s;
1091	+	//      writeln(FieldName,': ', StringCodePage(Value),', ',Value);
1092	+	{$ELSE}
1093		Value := string(Buffer);
1094	+	{$ENDIF}
1095		if Transliterate and (Value <> '') then
1096		DataSet.Translate(PChar(Value), PChar(Value), False);
1097		end
#	Line 725 | Line 1103 | end;
1103		procedure TIBStringField.SetAsString(const Value: string);
1104		var
1105		Buffer: PChar;
1106	+	s: RawByteString;
1107		begin
1108		Buffer := nil;
1109		IBAlloc(Buffer, 0, Size + 1);
1110		try
1111	<	StrLCopy(Buffer, PChar(Value), Size);
1111	>	s := Value;
1112	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1113	>	if StringCodePage(s) <> CodePage then
1114	>	SetCodePage(s,CodePage,true);
1115	>	{$ENDIF}
1116	>	StrLCopy(Buffer, PChar(s), Size);
1117		if Transliterate then
1118		DataSet.Translate(Buffer, Buffer, True);
1119		SetData(Buffer);
#	Line 738 | Line 1122 | begin
1122		end;
1123		end;
1124
1125	+
1126		{ TIBBCDField }
1127
1128		constructor TIBBCDField.Create(AOwner: TComponent);
#	Line 835 | Line 1220 | begin
1220		CheckIBLoaded;
1221		FIBLoaded := True;
1222		FBase := TIBBase.Create(Self);
1223	+	FIBLinks := TList.Create;
1224		FCurrentRecord := -1;
1225		FDeletedRecords := 0;
1226		FUniDirectional := False;
#	Line 853 | Line 1239 | begin
1239		FQRefresh.GoToFirstRecordOnExecute := False;
1240		FQSelect := TIBSQL.Create(Self);
1241		FQSelect.OnSQLChanging := SQLChanging;
1242	+	FQSelect.OnSQLChanged := SQLChanged;
1243		FQSelect.GoToFirstRecordOnExecute := False;
1244		FQModify := TIBSQL.Create(Self);
1245		FQModify.OnSQLChanging := SQLChanging;
1246		FQModify.GoToFirstRecordOnExecute := False;
1247		FUpdateRecordTypes := [cusUnmodified, cusModified, cusInserted];
1248		FParamCheck := True;
1249	+	FGenerateParamNames := False;
1250		FForcedRefresh := False;
1251	+	FAutoCommit:= acDisabled;
1252	+	FDataSetCloseAction := dcDiscardChanges;
1253		{Bookmark Size is Integer for IBX}
1254		BookmarkSize := SizeOf(Integer);
1255		FBase.BeforeDatabaseDisconnect := DoBeforeDatabaseDisconnect;
#	Line 873 | Line 1263 | begin
1263		else
1264		if AOwner is TIBTransaction then
1265		Transaction := TIBTransaction(AOwner);
1266	+	FBaseSQLSelect := TStringList.Create;
1267		end;
1268
1269		destructor TIBCustomDataSet.Destroy;
#	Line 884 | Line 1275 | begin
1275		FDataLink.Free;
1276		FBase.Free;
1277		ClearBlobCache;
1278	+	ClearIBLinks;
1279	+	FIBLinks.Free;
1280		FBlobStreamList.Free;
1281		FreeMem(FBufferCache);
1282		FBufferCache := nil;
#	Line 893 | Line 1286 | begin
1286		FOldCacheSize := 0;
1287		FMappedFieldPosition := nil;
1288		end;
1289	+	if assigned(FBaseSQLSelect) then FBaseSQLSelect.Free;
1290	+	if assigned(FParser) then FParser.Free;
1291		inherited Destroy;
1292		end;
1293
#	Line 934 | Line 1329 | end;
1329
1330		procedure TIBCustomDataSet.ApplyUpdates;
1331		var
1332	<	{$IF FPC_FULLVERSION > 20602 }
1332	>	{$IFDEF NEW_TBOOKMARK }
1333		CurBookmark: TBookmark;
1334		{$ELSE}
1335		CurBookmark: string;
#	Line 1136 | Line 1531 | begin
1531		end;
1532		end;
1533
1534	+	function TIBCustomDataSet.GetFieldPosition(AliasName: string): integer;
1535	+	var i: integer;
1536	+	Prepared: boolean;
1537	+	begin
1538	+	Result := 0;
1539	+	Prepared := FInternalPrepared;
1540	+	if not Prepared then
1541	+	InternalPrepare;
1542	+	try
1543	+	for i := 0 to Length(FAliasNameList) - 1 do
1544	+	if FAliasNameList[i] = AliasName then
1545	+	begin
1546	+	Result := i + 1;
1547	+	Exit
1548	+	end;
1549	+	finally
1550	+	if not Prepared then
1551	+	InternalUnPrepare;
1552	+	end;
1553	+	end;
1554	+
1555		procedure TIBCustomDataSet.ActivateConnection;
1556		begin
1557		if not Assigned(Database) then
#	Line 1196 | Line 1612 | begin
1612		IBError(ibxeDatasetClosed, [nil]);
1613		end;
1614
1615	+	function TIBCustomDataSet.CreateParser: TSelectSQLParser;
1616	+	begin
1617	+	Result := TSelectSQLParser.Create(self,FBaseSQLSelect);
1618	+	Result.OnSQLChanging := SQLChanging
1619	+	end;
1620	+
1621		procedure TIBCustomDataSet.CheckNotUniDirectional;
1622		begin
1623		if UniDirectional then
#	Line 1299 | Line 1721 | begin
1721		FDatabaseFree(Sender);
1722		end;
1723
1724	<	procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject);
1724	>	procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject;
1725	>	Action: TTransactionAction);
1726		begin
1727	<	if Active then
1728	<	Active := False;
1727	>	FCloseAction := Action;
1728	>	FInTransactionEnd := true;
1729	>	try
1730	>	if Active then
1731	>	Active := False;
1732	>	finally
1733	>	FInTransactionEnd := false;
1734	>	end;
1735		if FQSelect <> nil then
1736		FQSelect.FreeHandle;
1737		if FQDelete <> nil then
#	Line 1340 | Line 1769 | var
1769		LocalData: Pointer;
1770		LocalDate, LocalDouble: Double;
1771		LocalInt: Integer;
1772	+	LocalBool: wordBool;
1773		LocalInt64: Int64;
1774		LocalCurrency: Currency;
1775		FieldsLoaded: Integer;
#	Line 1484 | Line 1914 | begin
1914		end;
1915		end;
1916		end;
1917	+	SQL_BOOLEAN:
1918	+	begin
1919	+	LocalBool:= false;
1920	+	rdFields[j].fdDataSize := SizeOf(wordBool);
1921	+	if RecordNumber >= 0 then
1922	+	LocalBool := Qry.Current[i].AsBoolean;
1923	+	LocalData := PChar(@LocalBool);
1924	+	end;
1925		else { SQL_TEXT, SQL_BLOB, SQL_ARRAY, SQL_QUAD }
1926		begin
1927		rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
#	Line 1626 | Line 2064 | function TIBCustomDataSet.InternalLocate
2064		const KeyValues: Variant; Options: TLocateOptions): Boolean;
2065		var
2066		keyFieldList: TList;
2067	<	{$IF FPC_FULLVERSION >  20602 }
2067	>	{$IFDEF NEW_TBOOKMARK }
2068		CurBookmark: TBookmark;
2069		{$ELSE}
2070		CurBookmark: string;
#	Line 1755 | Line 2193 | end;
2193		procedure TIBCustomDataSet.InternalRefreshRow;
2194		var
2195		Buff: PChar;
1758	–	SetCursor: Boolean;
2196		ofs: DWORD;
2197		Qry: TIBSQL;
2198		begin
2199	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1763	<	if SetCursor then
1764	<	Screen.Cursor := crHourGlass;
2199	>	FBase.SetCursor;
2200		try
2201		Buff := GetActiveBuf;
2202		if CanRefresh then
#	Line 1805 | Line 2240 | begin
2240		else
2241		IBError(ibxeCannotRefresh, [nil]);
2242		finally
2243	<	if SetCursor and (Screen.Cursor = crHourGlass) then
1809	<	Screen.Cursor := crDefault;
2243	>	FBase.RestoreCursor;
2244		end;
2245		end;
2246
#	Line 1877 | Line 2311 | end;
2311
2312		procedure TIBCustomDataSet.InternalPrepare;
2313		var
1880	–	SetCursor: Boolean;
2314		DidActivate: Boolean;
2315		begin
2316		if FInternalPrepared then
2317		Exit;
2318		DidActivate := False;
2319	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1887	<	if SetCursor then
1888	<	Screen.Cursor := crHourGlass;
2319	>	FBase.SetCursor;
2320		try
2321		ActivateConnection;
2322		DidActivate := ActivateTransaction;
2323		FBase.CheckDatabase;
2324		FBase.CheckTransaction;
2325	+	if HasParser and (FParser.SQLText <> FQSelect.SQL.Text) then
2326	+	begin
2327	+	FQSelect.OnSQLChanged := nil; {Do not react to change}
2328	+	try
2329	+	FQSelect.SQL.Text := FParser.SQLText;
2330	+	finally
2331	+	FQSelect.OnSQLChanged := SQLChanged;
2332	+	end;
2333	+	end;
2334	+	//   writeln( FQSelect.SQL.Text);
2335		if FQSelect.SQL.Text <> '' then
2336		begin
2337		if not FQSelect.Prepared then
2338		begin
2339	+	FQSelect.GenerateParamNames := FGenerateParamNames;
2340		FQSelect.ParamCheck := ParamCheck;
2341		FQSelect.Prepare;
2342		end;
2343	+	FQDelete.GenerateParamNames := FGenerateParamNames;
2344		if (Trim(FQDelete.SQL.Text) <> '') and (not FQDelete.Prepared) then
2345		FQDelete.Prepare;
2346	+	FQInsert.GenerateParamNames := FGenerateParamNames;
2347		if (Trim(FQInsert.SQL.Text) <> '') and (not FQInsert.Prepared) then
2348		FQInsert.Prepare;
2349	+	FQRefresh.GenerateParamNames := FGenerateParamNames;
2350		if (Trim(FQRefresh.SQL.Text) <> '') and (not FQRefresh.Prepared) then
2351		FQRefresh.Prepare;
2352	+	FQModify.GenerateParamNames := FGenerateParamNames;
2353		if (Trim(FQModify.SQL.Text) <> '') and (not FQModify.Prepared) then
2354		FQModify.Prepare;
2355		FInternalPrepared := True;
#	Line 1913 | Line 2359 | begin
2359		finally
2360		if DidActivate then
2361		DeactivateTransaction;
2362	<	if SetCursor and (Screen.Cursor = crHourGlass) then
1917	<	Screen.Cursor := crDefault;
2362	>	FBase.RestoreCursor;
2363		end;
2364		end;
2365
#	Line 2105 | Line 2550 | begin
2550		SQL_TIMESTAMP:
2551		Qry.Params[i].AsDateTime :=
2552		TimeStampToDateTime(MSecsToTimeStamp(trunc(PDouble(data)^)));
2553	+	SQL_BOOLEAN:
2554	+	Qry.Params[i].AsBoolean := PWordBool(data)^;
2555		end;
2556		end;
2557		end;
#	Line 2190 | Line 2637 | begin
2637		end;
2638		end;
2639
2640	+	procedure TIBCustomDataSet.RegisterIBLink(Sender: TIBControlLink);
2641	+	begin
2642	+	if FIBLinks.IndexOf(Sender) = -1 then
2643	+	FIBLinks.Add(Sender);
2644	+	end;
2645	+
2646
2647		procedure TIBCustomDataSet.SQLChanging(Sender: TObject);
2648		begin
2649	<	if FOpen then
2650	<	InternalClose;
2649	>	Active := false;
2650	>	{  if FOpen then
2651	>	InternalClose;}
2652		if FInternalPrepared then
2653		InternalUnPrepare;
2654	+	FieldDefs.Clear;
2655	+	FieldDefs.Updated := false;
2656	+	end;
2657	+
2658	+	procedure TIBCustomDataSet.SQLChanged(Sender: TObject);
2659	+	begin
2660	+	FBaseSQLSelect.assign(FQSelect.SQL);
2661		end;
2662
2663		{ I can "undelete" uninserted records (make them "inserted" again).
#	Line 2225 | Line 2686 | begin
2686		end;
2687		end;
2688
2689	+	procedure TIBCustomDataSet.UnRegisterIBLink(Sender: TIBControlLink);
2690	+	begin
2691	+	FIBLinks.Remove(Sender);
2692	+	end;
2693	+
2694		function TIBCustomDataSet.UpdateStatus: TUpdateStatus;
2695		begin
2696		if Active then
#	Line 2454 | Line 2920 | begin
2920		inherited DoBeforeDelete;
2921		end;
2922
2923	+	procedure TIBCustomDataSet.DoAfterDelete;
2924	+	begin
2925	+	inherited DoAfterDelete;
2926	+	FBase.DoAfterDelete(self);
2927	+	InternalAutoCommit;
2928	+	end;
2929	+
2930		procedure TIBCustomDataSet.DoBeforeEdit;
2931		var
2932		Buff: PRecordData;
#	Line 2468 | Line 2941 | begin
2941		inherited DoBeforeEdit;
2942		end;
2943
2944	+	procedure TIBCustomDataSet.DoAfterEdit;
2945	+	begin
2946	+	inherited DoAfterEdit;
2947	+	FBase.DoAfterEdit(self);
2948	+	end;
2949	+
2950		procedure TIBCustomDataSet.DoBeforeInsert;
2951		begin
2952		if not CanInsert then
#	Line 2480 | Line 2959 | begin
2959		if GeneratorField.ApplyOnEvent = gaeOnNewRecord then
2960		GeneratorField.Apply;
2961		inherited DoAfterInsert;
2962	+	FBase.DoAfterInsert(self);
2963	+	end;
2964	+
2965	+	procedure TIBCustomDataSet.DoBeforeClose;
2966	+	begin
2967	+	inherited DoBeforeClose;
2968	+	if State in [dsInsert,dsEdit] then
2969	+	begin
2970	+	if FInTransactionEnd and (FCloseAction = TARollback) then
2971	+	Exit;
2972	+
2973	+	if DataSetCloseAction = dcSaveChanges then
2974	+	Post;
2975	+	{Note this can fail with an exception e.g. due to
2976	+	database validation error. In which case the dataset remains open }
2977	+	end;
2978	+	end;
2979	+
2980	+	procedure TIBCustomDataSet.DoBeforeOpen;
2981	+	var i: integer;
2982	+	begin
2983	+	if assigned(FParser) then
2984	+	FParser.Reset;
2985	+	for i := 0 to FIBLinks.Count - 1 do
2986	+	TIBControlLink(FIBLinks[i]).UpdateSQL(self);
2987	+	inherited DoBeforeOpen;
2988	+	for i := 0 to FIBLinks.Count - 1 do
2989	+	TIBControlLink(FIBLinks[i]).UpdateParams(self);
2990		end;
2991
2992		procedure TIBCustomDataSet.DoBeforePost;
#	Line 2490 | Line 2997 | begin
2997		GeneratorField.Apply
2998		end;
2999
3000	+	procedure TIBCustomDataSet.DoAfterPost;
3001	+	begin
3002	+	inherited DoAfterPost;
3003	+	FBase.DoAfterPost(self);
3004	+	InternalAutoCommit;
3005	+	end;
3006	+
3007		procedure TIBCustomDataSet.FetchAll;
3008		var
3009	<	SetCursor: Boolean;
2496	<	{$IF FPC_FULLVERSION >  20602 }
3009	>	{$IFDEF NEW_TBOOKMARK }
3010		CurBookmark: TBookmark;
3011		{$ELSE}
3012		CurBookmark: string;
3013		{$ENDIF}
3014		begin
3015	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3016	<	if SetCursor then
2504	<	Screen.Cursor := crHourGlass;
2505	<	try
3015	>	FBase.SetCursor;
3016	>	try
3017		if FQSelect.EOF or not FQSelect.Open then
3018		exit;
3019		DisableControls;
#	Line 2514 | Line 3025 | begin
3025		EnableControls;
3026		end;
3027		finally
3028	<	if SetCursor and (Screen.Cursor = crHourGlass) then
2518	<	Screen.Cursor := crDefault;
3028	>	FBase.RestoreCursor;
3029		end;
3030		end;
3031
#	Line 2563 | Line 3073 | begin
3073		result := FDataLink.DataSource;
3074		end;
3075
3076	+	function TIBCustomDataSet.GetDBAliasName(FieldNo: integer): string;
3077	+	begin
3078	+	Result := FAliasNameMap[FieldNo-1]
3079	+	end;
3080	+
3081	+	function TIBCustomDataSet.GetFieldDefFromAlias(aliasName: string): TFieldDef;
3082	+	var
3083	+	i: integer;
3084	+	begin
3085	+	Result := nil;
3086	+	for i := 0 to Length(FAliasNameMap) - 1 do
3087	+	if FAliasNameMap[i] = aliasName then
3088	+	begin
3089	+	Result := FieldDefs[i];
3090	+	Exit
3091	+	end;
3092	+	end;
3093	+
3094		function TIBCustomDataSet.GetFieldClass(FieldType: TFieldType): TFieldClass;
3095		begin
3096		Result := DefaultFieldClasses[FieldType];
#	Line 2603 | Line 3131 | begin
3131		Data := Buff + CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs;
3132		if (fdDataType = SQL_VARYING) or (fdDataType = SQL_TEXT) then
3133		begin
3134	<	if fdDataLength <= Field.Size then
3134	>	if fdDataLength < Field.DataSize then
3135		begin
3136		Move(Data^, Buffer^, fdDataLength);
3137		PChar(Buffer)[fdDataLength] := #0;
#	Line 2652 | Line 3180 | begin
3180		if not Accept and (GetMode = gmCurrent) then
3181		GetMode := gmPrior;
3182		except
3183	<	//        Application.HandleException(Self);
3183	>	//        FBase.HandleException(Self);
3184		end;
3185		end;
3186		RestoreState(SaveState);
#	Line 2746 | Line 3274 | begin
3274		result := FRecordBufferSize;
3275		end;
3276
3277	+	procedure TIBCustomDataSet.InternalAutoCommit;
3278	+	begin
3279	+	with Transaction do
3280	+	if InTransaction and (FAutoCommit = acCommitRetaining) then
3281	+	begin
3282	+	if CachedUpdates then ApplyUpdates;
3283	+	CommitRetaining;
3284	+	end;
3285	+	end;
3286	+
3287		procedure TIBCustomDataSet.InternalAddRecord(Buffer: Pointer; Append: Boolean);
3288		begin
3289		CheckEditState;
#	Line 2817 | Line 3355 | begin
3355		FreeMem(FOldBufferCache);
3356		FOldBufferCache := nil;
3357		BindFields(False);
3358	+	ResetParser;
3359		if DefaultFields then DestroyFields;
3360		end;
3361
3362		procedure TIBCustomDataSet.InternalDelete;
3363		var
3364		Buff: PChar;
2826	–	SetCursor: Boolean;
3365		begin
3366	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
2829	<	if SetCursor then
2830	<	Screen.Cursor := crHourGlass;
3366	>	FBase.SetCursor;
3367		try
3368		Buff := GetActiveBuf;
3369		if CanDelete then
#	Line 2852 | Line 3388 | begin
3388		end else
3389		IBError(ibxeCannotDelete, [nil]);
3390		finally
3391	<	if SetCursor and (Screen.Cursor = crHourGlass) then
2856	<	Screen.Cursor := crDefault;
3391	>	FBase.RestoreCursor;
3392		end;
3393		end;
3394
#	Line 2869 | Line 3404 | end;
3404
3405		procedure TIBCustomDataSet.InternalHandleException;
3406		begin
3407	<	Application.HandleException(Self)
3407	>	FBase.HandleException(Self)
3408		end;
3409
3410		procedure TIBCustomDataSet.InternalInitFieldDefs;
3411	+	begin
3412	+	if not InternalPrepared then
3413	+	begin
3414	+	InternalPrepare;
3415	+	exit;
3416	+	end;
3417	+	FieldDefsFromQuery(FQSelect);
3418	+	end;
3419	+
3420	+	procedure TIBCustomDataSet.FieldDefsFromQuery(SourceQuery: TIBSQL);
3421		const
3422		DefaultSQL = 'Select F.RDB$COMPUTED_BLR, ' + {do not localize}
3423		'F.RDB$DEFAULT_VALUE, R.RDB$FIELD_NAME ' + {do not localize}
#	Line 2884 | Line 3429 | const
3429		var
3430		FieldType: TFieldType;
3431		FieldSize: Word;
3432	+	charSetID: short;
3433	+	CharSetSize: integer;
3434	+	CharSetName: RawByteString;
3435	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3436	+	FieldCodePage: TSystemCodePage;
3437	+	{$ENDIF}
3438		FieldNullable : Boolean;
3439		i, FieldPosition, FieldPrecision: Integer;
3440	<	FieldAliasName: string;
3440	>	FieldAliasName, DBAliasName: string;
3441		RelationName, FieldName: string;
3442		Query : TIBSQL;
3443		FieldIndex: Integer;
#	Line 2986 | Line 3537 | var
3537		end;
3538
3539		begin
2989	–	if not InternalPrepared then
2990	–	begin
2991	–	InternalPrepare;
2992	–	exit;
2993	–	end;
3540		FRelationNodes := TRelationNode.Create;
3541		FNeedsRefresh := False;
3542		Database.InternalTransaction.StartTransaction;
#	Line 3001 | Line 3547 | begin
3547		FieldDefs.BeginUpdate;
3548		FieldDefs.Clear;
3549		FieldIndex := 0;
3550	<	if (Length(FMappedFieldPosition) < FQSelect.Current.Count) then
3551	<	SetLength(FMappedFieldPosition, FQSelect.Current.Count);
3550	>	if (Length(FMappedFieldPosition) < SourceQuery.Current.Count) then
3551	>	SetLength(FMappedFieldPosition, SourceQuery.Current.Count);
3552		Query.SQL.Text := DefaultSQL;
3553		Query.Prepare;
3554	<	for i := 0 to FQSelect.Current.Count - 1 do
3555	<	with FQSelect.Current[i].Data^ do
3554	>	SetLength(FAliasNameMap, SourceQuery.Current.Count);
3555	>	SetLength(FAliasNameList, SourceQuery.Current.Count);
3556	>	for i := 0 to SourceQuery.Current.Count - 1 do
3557	>	with SourceQuery.Current[i].Data^ do
3558		begin
3559		{ Get the field name }
3560	<	SetString(FieldAliasName, aliasname, aliasname_length);
3560	>	FieldAliasName := SourceQuery.Current[i].Name;
3561	>	SetString(DBAliasName, aliasname, aliasname_length);
3562		SetString(RelationName, relname, relname_length);
3563		SetString(FieldName, sqlname, sqlname_length);
3564	+	FAliasNameList[i] := DBAliasName;
3565		FieldSize := 0;
3566		FieldPrecision := 0;
3567	<	FieldNullable := FQSelect.Current[i].IsNullable;
3567	>	FieldNullable := SourceQuery.Current[i].IsNullable;
3568	>	CharSetSize := 0;
3569	>	CharSetName := '';
3570	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3571	>	FieldCodePage := CP_NONE;
3572	>	{$ENDIF}
3573		case sqltype and not 1 of
3574		{ All VARCHAR's must be converted to strings before recording
3575		their values }
3576		SQL_VARYING, SQL_TEXT:
3577		begin
3578	+	CharSetSize := FBase.GetCharSetSize(sqlsubtype and $FF);
3579	+	CharSetName := FBase.GetCharSetName(sqlsubtype and $FF);
3580	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3581	+	FieldCodePage := FBase.GetCodePage(sqlsubtype and $FF);
3582	+	{$ENDIF}
3583	+	{FieldSize is encoded for strings - see TIBStringField.SetSize for decode}
3584		FieldSize := sqllen;
3585	<	FieldType := ftString;
3585	>	if CharSetSize = 2 then
3586	>	FieldType := ftWideString
3587	>	else
3588	>	FieldType := ftString;
3589		end;
3590		{ All Doubles/Floats should be cast to doubles }
3591		SQL_DOUBLE, SQL_FLOAT:
#	Line 3080 | Line 3644 | begin
3644		begin
3645		FieldSize := sizeof (TISC_QUAD);
3646		if (sqlsubtype = 1) then
3647	<	FieldType := ftmemo
3647	>	begin
3648	>	if FBase.GetDefaultCharSetName <> '' then
3649	>	begin
3650	>	CharSetSize := FBase.GetDefaultCharSetSize;
3651	>	CharSetName := FBase.GetDefaultCharSetName;
3652	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3653	>	FieldCodePage := FBase.GetDefaultCodePage;
3654	>	{$ENDIF}
3655	>	end
3656	>	else
3657	>	if strpas(sqlname) <> '' then
3658	>	begin
3659	>	charSetID := GetBlobCharSetID(Database.Handle,Database.InternalTransaction.Handle,
3660	>	@relname,@sqlname);
3661	>	CharSetSize := FBase.GetCharSetSize(charSetID);
3662	>	CharSetName := FBase.GetCharSetName(charSetID);
3663	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3664	>	FieldCodePage := FBase.GetCodePage(charSetID);
3665	>	{$ENDIF}
3666	>	end
3667	>	else  {Complex SQL with no identifiable column and no connection default}
3668	>	begin
3669	>	CharSetName := '';
3670	>	CharSetSize := 1;
3671	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3672	>	FieldCodePage := CP_NONE;
3673	>	{$ENDIF}
3674	>	end;
3675	>	if CharSetSize = 2 then
3676	>	FieldType := ftWideMemo
3677	>	else
3678	>	FieldType := ftMemo;
3679	>	end
3680		else
3681		FieldType := ftBlob;
3682		end;
#	Line 3089 | Line 3685 | begin
3685		FieldSize := sizeof (TISC_QUAD);
3686		FieldType := ftUnknown;
3687		end;
3688	+	SQL_BOOLEAN:
3689	+	FieldType:= ftBoolean;
3690		else
3691		FieldType := ftUnknown;
3692		end;
#	Line 3097 | Line 3695 | begin
3695		begin
3696		FMappedFieldPosition[FieldIndex] := FieldPosition;
3697		Inc(FieldIndex);
3698	<	with FieldDefs.AddFieldDef do
3698	>	with TIBFieldDef.Create(FieldDefs,'',FieldType,0,False,FieldDefs.Count+1) do
3699		begin
3700		Name := FieldAliasName;
3701	<	(*           FieldNo := FieldPosition;*)
3104	<	DataType := FieldType;
3701	>	FAliasNameMap[FieldNo-1] := DBAliasName;
3702		Size := FieldSize;
3703		Precision := FieldPrecision;
3704		Required := not FieldNullable;
3705		InternalCalcField := False;
3706	+	CharacterSetSize := CharSetSize;
3707	+	CharacterSetName := CharSetName;
3708	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3709	+	CodePage := FieldCodePage;
3710	+	{$ENDIF}
3711		if (FieldName <> '') and (RelationName <> '') then
3712		begin
3713		if Has_COMPUTED_BLR(RelationName, FieldName) then
#	Line 3185 | Line 3787 | begin
3787		else case cur_field.DataType of
3788		ftString:
3789		cur_param.AsString := cur_field.AsString;
3790	<	ftBoolean, ftSmallint, ftWord:
3790	>	ftBoolean:
3791	>	cur_param.AsBoolean := cur_field.AsBoolean;
3792	>	ftSmallint, ftWord:
3793		cur_param.AsShort := cur_field.AsInteger;
3794		ftInteger:
3795		cur_param.AsLong := cur_field.AsInteger;
#	Line 3238 | Line 3842 | begin
3842		end;
3843
3844		procedure TIBCustomDataSet.InternalOpen;
3241	–	var
3242	–	SetCursor: Boolean;
3845
3846		function RecordDataLength(n: Integer): Long;
3847		begin
3848		result := SizeOf(TRecordData) + ((n - 1) * SizeOf(TFieldData));
3849		end;
3850
3851	+	function GetFieldDef(aFieldNo: integer): TIBFieldDef;
3852	+	var i: integer;
3853	+	begin
3854	+	Result := nil;
3855	+	for i := 0 to FieldDefs.Count - 1 do
3856	+	if FieldDefs[i].FieldNo = aFieldNo then
3857	+	begin
3858	+	Result := TIBFieldDef(FieldDefs[i]);
3859	+	break;
3860	+	end;
3861	+	end;
3862	+
3863	+	procedure SetExtendedProperties;
3864	+	var i: integer;
3865	+	IBFieldDef: TIBFieldDef;
3866	+	begin
3867	+	for i := 0 to Fields.Count - 1 do
3868	+	if Fields[i].FieldNo > 0 then
3869	+	begin
3870	+	if(Fields[i] is TIBStringField) then
3871	+	with TIBStringField(Fields[i]) do
3872	+	begin
3873	+	IBFieldDef := GetFieldDef(FieldNo);
3874	+	if IBFieldDef <> nil then
3875	+	begin
3876	+	CharacterSetSize := IBFieldDef.CharacterSetSize;
3877	+	CharacterSetName := IBFieldDef.CharacterSetName;
3878	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3879	+	CodePage := IBFieldDef.CodePage;
3880	+	{$ENDIF}
3881	+	end;
3882	+	end
3883	+	else
3884	+	if(Fields[i] is TIBWideStringField) then
3885	+	with TIBWideStringField(Fields[i]) do
3886	+	begin
3887	+	IBFieldDef := GetFieldDef(FieldNo);
3888	+	if IBFieldDef <> nil then
3889	+	begin
3890	+	CharacterSetSize := IBFieldDef.CharacterSetSize;
3891	+	CharacterSetName := IBFieldDef.CharacterSetName;
3892	+	end;
3893	+	end
3894	+	else
3895	+	if(Fields[i] is TIBMemoField) then
3896	+	with TIBMemoField(Fields[i]) do
3897	+	begin
3898	+	IBFieldDef := GetFieldDef(FieldNo);
3899	+	if IBFieldDef <> nil then
3900	+	begin
3901	+	CharacterSetSize := IBFieldDef.CharacterSetSize;
3902	+	CharacterSetName := IBFieldDef.CharacterSetName;
3903	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3904	+	CodePage := IBFieldDef.CodePage;
3905	+	{$ENDIF}
3906	+	end;
3907	+	end
3908	+	else
3909	+	if(Fields[i] is TIBWideMemoField) then
3910	+	with TIBWideMemoField(Fields[i]) do
3911	+	begin
3912	+	IBFieldDef := GetFieldDef(FieldNo);
3913	+	if IBFieldDef <> nil then
3914	+	begin
3915	+	CharacterSetSize := IBFieldDef.CharacterSetSize;
3916	+	CharacterSetName := IBFieldDef.CharacterSetName;
3917	+	end;
3918	+	end
3919	+	end
3920	+	end;
3921	+
3922		begin
3923	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3251	<	if SetCursor then
3252	<	Screen.Cursor := crHourGlass;
3923	>	FBase.SetCursor;
3924		try
3925		ActivateConnection;
3926		ActivateTransaction;
#	Line 3262 | Line 3933 | begin
3933		if DefaultFields then
3934		CreateFields;
3935		BindFields(True);
3936	+	SetExtendedProperties;
3937		FCurrentRecord := -1;
3938		FQSelect.ExecQuery;
3939		FOpen := FQSelect.Open;
#	Line 3310 | Line 3982 | begin
3982		else
3983		FQSelect.ExecQuery;
3984		finally
3985	<	if SetCursor and (Screen.Cursor = crHourGlass) then
3314	<	Screen.Cursor := crDefault;
3985	>	FBase.RestoreCursor;
3986		end;
3987		end;
3988
#	Line 3319 | Line 3990 | procedure TIBCustomDataSet.InternalPost;
3990		var
3991		Qry: TIBSQL;
3992		Buff: PChar;
3322	–	SetCursor: Boolean;
3993		bInserting: Boolean;
3994		begin
3995	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3326	<	if SetCursor then
3327	<	Screen.Cursor := crHourGlass;
3995	>	FBase.SetCursor;
3996		try
3997		Buff := GetActiveBuf;
3998		CheckEditState;
#	Line 3362 | Line 4030 | begin
4030		if bInserting then
4031		Inc(FRecordCount);
4032		finally
4033	<	if SetCursor and (Screen.Cursor = crHourGlass) then
3366	<	Screen.Cursor := crDefault;
4033	>	FBase.RestoreCursor;
4034		end;
4035		end;
4036
#	Line 3383 | Line 4050 | begin
4050		result := FOpen;
4051		end;
4052
4053	+	procedure TIBCustomDataSet.Loaded;
4054	+	begin
4055	+	if assigned(FQSelect) then
4056	+	FBaseSQLSelect.assign(FQSelect.SQL);
4057	+	inherited Loaded;
4058	+	end;
4059	+
4060	+	procedure TIBCustomDataSet.Post;
4061	+	var CancelPost: boolean;
4062	+	begin
4063	+	CancelPost := false;
4064	+	if assigned(FOnValidatePost) then
4065	+	OnValidatePost(self,CancelPost);
4066	+	if CancelPost then
4067	+	Cancel
4068	+	else
4069	+	inherited Post;
4070	+	end;
4071	+
4072		function TIBCustomDataSet.Locate(const KeyFields: string; const KeyValues: Variant;
4073		Options: TLocateOptions): Boolean;
4074		var
4075	<	{$IF FPC_FULLVERSION >  20602 }
4075	>	{$IFDEF NEW_TBOOKMARK }
4076		CurBookmark: TBookmark;
4077		{$ELSE}
4078		CurBookmark: string;
#	Line 3408 | Line 4094 | function TIBCustomDataSet.Lookup(const K
4094		const ResultFields: string): Variant;
4095		var
4096		fl: TList;
4097	<	{$IF FPC_FULLVERSION >  20602 }
4097	>	{$IFDEF NEW_TBOOKMARK }
4098		CurBookmark: TBookmark;
4099		{$ELSE}
4100		CurBookmark: string;
#	Line 3465 | Line 4151 | end;
4151		procedure TIBCustomDataSet.InternalSetFieldData(Field: TField; Buffer: Pointer);
4152		var
4153		Buff, TmpBuff: PChar;
4154	+	MappedFieldPos: integer;
4155		begin
4156		Buff := GetActiveBuf;
4157		if Field.FieldNo < 0 then
#	Line 3481 | Line 4168 | begin
4168		begin
4169		{ If inserting, Adjust record position }
4170		AdjustRecordOnInsert(Buff);
4171	<	if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and
4172	<	(FMappedFieldPosition[Field.FieldNo - 1] <= rdFieldCount) then
4171	>	MappedFieldPos := FMappedFieldPosition[Field.FieldNo - 1];
4172	>	if (MappedFieldPos > 0) and
4173	>	(MappedFieldPos <= rdFieldCount) then
4174		begin
4175		Field.Validate(Buffer);
4176		if (Buffer = nil) or
4177		(Field is TIBStringField) and (PChar(Buffer)[0] = #0) then
4178	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull := True
4178	>	rdFields[MappedFieldPos].fdIsNull := True
4179		else begin
4180	<	Move(Buffer^, Buff[rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs],
4181	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataSize);
4182	<	if (rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_TEXT) or
4183	<	(rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_VARYING) then
4184	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataLength := StrLen(PChar(Buffer));
4185	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull := False;
4180	>	Move(Buffer^, Buff[rdFields[MappedFieldPos].fdDataOfs],
4181	>	rdFields[MappedFieldPos].fdDataSize);
4182	>	if (rdFields[MappedFieldPos].fdDataType = SQL_TEXT) or
4183	>	(rdFields[MappedFieldPos].fdDataType = SQL_VARYING) then
4184	>	rdFields[MappedFieldPos].fdDataLength := StrLen(PChar(Buffer));
4185	>	rdFields[MappedFieldPos].fdIsNull := False;
4186		if rdUpdateStatus = usUnmodified then
4187		begin
4188		if CachedUpdates then
#	Line 3582 | Line 4270 | begin
4270		FillChar(Buffer[FRecordSize], CalcFieldsSize, 0);
4271		end;
4272
4273	+	procedure TIBCustomDataSet.ClearIBLinks;
4274	+	var i: integer;
4275	+	begin
4276	+	for i := FIBLinks.Count - 1 downto 0 do
4277	+	TIBControlLink(FIBLinks[i]).IBDataSet := nil;
4278	+	end;
4279	+
4280
4281		procedure TIBCustomDataSet.InternalUnPrepare;
4282		begin
#	Line 3589 | Line 4284 | begin
4284		begin
4285		CheckDatasetClosed;
4286		FieldDefs.Clear;
4287	+	FieldDefs.Updated := false;
4288		FInternalPrepared := False;
4289	+	Setlength(FAliasNameList,0);
4290		end;
4291		end;
4292
4293		procedure TIBCustomDataSet.InternalExecQuery;
4294		var
4295		DidActivate: Boolean;
3599	–	SetCursor: Boolean;
4296		begin
4297		DidActivate := False;
4298	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3603	<	if SetCursor then
3604	<	Screen.Cursor := crHourGlass;
4298	>	FBase.SetCursor;
4299		try
4300		ActivateConnection;
4301		DidActivate := ActivateTransaction;
#	Line 3618 | Line 4312 | begin
4312		finally
4313		if DidActivate then
4314		DeactivateTransaction;
4315	<	if SetCursor and (Screen.Cursor = crHourGlass) then
3622	<	Screen.Cursor := crDefault;
4315	>	FBase.RestoreCursor;
4316		end;
4317		end;
4318
#	Line 3628 | Line 4321 | begin
4321		Result := FQSelect.Handle;
4322		end;
4323
4324	+	function TIBCustomDataSet.GetParser: TSelectSQLParser;
4325	+	begin
4326	+	if not assigned(FParser) then
4327	+	FParser := CreateParser;
4328	+	Result := FParser
4329	+	end;
4330	+
4331	+	procedure TIBCustomDataSet.ResetParser;
4332	+	begin
4333	+	if assigned(FParser) then
4334	+	begin
4335	+	FParser.Free;
4336	+	FParser := nil;
4337	+	FQSelect.OnSQLChanged := nil; {Do not react to change}
4338	+	try
4339	+	FQSelect.SQL.Assign(FBaseSQLSelect);
4340	+	finally
4341	+	FQSelect.OnSQLChanged := SQLChanged;
4342	+	end;
4343	+	end;
4344	+	end;
4345	+
4346	+	function TIBCustomDataSet.HasParser: boolean;
4347	+	begin
4348	+	Result := not (csDesigning in ComponentState) and (FParser <> nil)
4349	+	end;
4350	+
4351	+	procedure TIBCustomDataSet.SetGenerateParamNames(AValue: Boolean);
4352	+	begin
4353	+	if FGenerateParamNames = AValue then Exit;
4354	+	FGenerateParamNames := AValue;
4355	+	Disconnect
4356	+	end;
4357	+
4358		procedure TIBCustomDataSet.InitRecord(Buffer: PChar);
4359		begin
4360		inherited InitRecord(Buffer);
#	Line 3951 | Line 4678 | begin
4678		DataSet.SetInternalSQLParams(Query, buff);
4679		end;
4680
4681	+	function TIBDSBlobStream.GetSize: Int64;
4682	+	begin
4683	+	Result := FBlobStream.BlobSize;
4684	+	end;
4685	+
4686		{ TIBDSBlobStream }
4687		constructor TIBDSBlobStream.Create(AField: TField; ABlobStream: TIBBlobStream;
4688		Mode: TBlobStreamMode);
#	Line 3959 | Line 4691 | begin
4691		FBlobStream := ABlobStream;
4692		FBlobStream.Seek(0, soFromBeginning);
4693		if (Mode = bmWrite) then
4694	+	begin
4695		FBlobStream.Truncate;
4696	+	TIBCustomDataSet(FField.DataSet).RecordModified(True);
4697	+	TBlobField(FField).Modified := true;
4698	+	FHasWritten := true;
4699	+	end;
4700	+	end;
4701	+
4702	+	destructor TIBDSBlobStream.Destroy;
4703	+	begin
4704	+	if FHasWritten then
4705	+	TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
4706	+	inherited Destroy;
4707		end;
4708
4709		function TIBDSBlobStream.Read(var Buffer; Count: Longint): Longint;
#	Line 3984 | Line 4728 | begin
4728		TIBCustomDataSet(FField.DataSet).RecordModified(True);
4729		TBlobField(FField).Modified := true;
4730		result := FBlobStream.Write(Buffer, Count);
4731	<	TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
4731	>	FHasWritten := true;
4732	>	{  TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
4733	>	Removed as this caused a seek to beginning of the blob stream thus corrupting
4734	>	the blob stream. Moved to the destructor i.e. called after blob written}
4735		end;
4736
4737		{ TIBGenerator }
#	Line 4031 | Line 4778 | end;
4778
4779		procedure TIBGenerator.Apply;
4780		begin
4781	<	if (FGeneratorName <> '') and (FFieldName <> '')  then
4781	>	if (FGeneratorName <> '') and (FFieldName <> '') and Owner.FieldByName(FFieldName).IsNull then
4782		Owner.FieldByName(FFieldName).AsInteger := GetNextValue(Owner.Database,Owner.Transaction);
4783		end;
4784
4785	+
4786		end.

Diff Legend

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