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 17 by tony, Sat Dec 28 19:22:24 2013 UTC vs.
Revision 31 by tony, Tue Jul 14 15:31:25 2015 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	+	FInitialised: boolean;
124	+	protected
125	+	procedure SetSize(AValue: Integer); override;
126		public
127		constructor create(AOwner: TComponent); override;
128		class procedure CheckTypeSize(Value: Integer); override;
#	Line 185 | Line 190 | type
190		property ApplyOnEvent: TIBGeneratorApplyOnEvent read FApplyOnEvent write FApplyOnEvent;
191		end;
192
193	+	{TIBControlLink - Allows IB Aware controls to react to dataset state changes}
194	+
195	+	TIBControlLink = class
196	+	private
197	+	FTIBDataSet: TIBCustomDataSet;
198	+	procedure SetIBDataSet(AValue: TIBCustomDataSet);
199	+	protected
200	+	procedure UpdateSQL(Sender: TObject); virtual;
201	+	procedure UpdateParams(Sender: TObject); virtual;
202	+	public
203	+	destructor Destroy; override;
204	+	property IBDataSet: TIBCustomDataSet read FTIBDataSet write SetIBDataSet;
205	+	end;
206	+
207	+	TIBAutoCommit = (acDisabled, acCommitRetaining);
208	+
209		{ TIBCustomDataSet }
210		TIBUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApply, uaApplied);
211
212		TIBUpdateErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
213	<	UpdateKind: TUpdateKind; var UpdateAction: TIBUpdateAction)
213	>	UpdateKind: TUpdateKind; var TheUpdateAction: TIBUpdateAction)
214		of object;
215		TIBUpdateRecordEvent = procedure(DataSet: TDataSet; UpdateKind: TUpdateKind;
216		var UpdateAction: TIBUpdateAction) of object;
217
218		TIBUpdateRecordTypes = set of TCachedUpdateStatus;
219
220	+	TDataSetCloseAction = (dcDiscardChanges, dcSaveChanges);
221	+
222	+	TOnValidatePost = procedure (Sender: TObject; var CancelPost: boolean) of object;
223	+
224		TIBCustomDataSet = class(TDataset)
225		private
226	+	FAutoCommit: TIBAutoCommit;
227	+	FGenerateParamNames: Boolean;
228		FGeneratorField: TIBGenerator;
229		FNeedsRefresh: Boolean;
230		FForcedRefresh: Boolean;
#	Line 223 | Line 250 | type
250		FDeletedRecords: Long;
251		FModelBuffer,
252		FOldBuffer: PChar;
253	+	FOnValidatePost: TOnValidatePost;
254		FOpen: Boolean;
255		FInternalPrepared: Boolean;
256		FQDelete,
#	Line 233 | Line 261 | type
261		FRecordBufferSize: Integer;
262		FRecordCount: Integer;
263		FRecordSize: Integer;
264	+	FDataSetCloseAction: TDataSetCloseAction;
265		FUniDirectional: Boolean;
266		FUpdateMode: TUpdateMode;
267		FUpdateObject: TIBDataSetUpdateObject;
#	Line 250 | Line 279 | type
279		FBeforeTransactionEnd,
280		FAfterTransactionEnd,
281		FTransactionFree: TNotifyEvent;
282	<
282	>	FAliasNameMap: array of string;
283	>	FAliasNameList: array of string;
284	>	FBaseSQLSelect: TStrings;
285	>	FParser: TSelectSQLParser;
286	>	FCloseAction: TTransactionAction;
287	>	FInTransactionEnd: boolean;
288	>	FIBLinks: TList;
289		function GetSelectStmtHandle: TISC_STMT_HANDLE;
290		procedure SetUpdateMode(const Value: TUpdateMode);
291		procedure SetUpdateObject(Value: TIBDataSetUpdateObject);
#	Line 263 | Line 298 | type
298		function CanRefresh: Boolean;
299		procedure CheckEditState;
300		procedure ClearBlobCache;
301	+	procedure ClearIBLinks;
302		procedure CopyRecordBuffer(Source, Dest: Pointer);
303		procedure DoBeforeDatabaseDisconnect(Sender: TObject);
304		procedure DoAfterDatabaseDisconnect(Sender: TObject);
305		procedure DoDatabaseFree(Sender: TObject);
306	<	procedure DoBeforeTransactionEnd(Sender: TObject);
306	>	procedure DoBeforeTransactionEnd(Sender: TObject; Action: TTransactionAction);
307		procedure DoAfterTransactionEnd(Sender: TObject);
308		procedure DoTransactionFree(Sender: TObject);
309		procedure FetchCurrentRecordToBuffer(Qry: TIBSQL; RecordNumber: Integer;
#	Line 283 | Line 319 | type
319		function GetModifySQL: TStrings;
320		function GetTransaction: TIBTransaction;
321		function GetTRHandle: PISC_TR_HANDLE;
322	+	function GetParser: TSelectSQLParser;
323		procedure InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer); virtual;
324		function InternalLocate(const KeyFields: string; const KeyValues: Variant;
325		Options: TLocateOptions): Boolean; virtual;
326		procedure InternalPostRecord(Qry: TIBSQL; Buff: Pointer); virtual;
327		procedure InternalRevertRecord(RecordNumber: Integer); virtual;
328		function IsVisible(Buffer: PChar): Boolean;
329	+	procedure RegisterIBLink(Sender: TIBControlLink);
330	+	procedure UnRegisterIBLink(Sender: TIBControlLink);
331		procedure SaveOldBuffer(Buffer: PChar);
332		procedure SetBufferChunks(Value: Integer);
333		procedure SetDatabase(Value: TIBDatabase);
#	Line 321 | Line 360 | type
360		procedure DeactivateTransaction;
361		procedure CheckDatasetClosed;
362		procedure CheckDatasetOpen;
363	+	function CreateParser: TSelectSQLParser; virtual;
364	+	procedure FieldDefsFromQuery(SourceQuery: TIBSQL);
365		function GetActiveBuf: PChar;
366		procedure InternalBatchInput(InputObject: TIBBatchInput); virtual;
367		procedure InternalBatchOutput(OutputObject: TIBBatchOutput); virtual;
#	Line 353 | Line 394 | type
394		procedure ClearCalcFields(Buffer: PChar); override;
395		function AllocRecordBuffer: PChar; override;
396		procedure DoBeforeDelete; override;
397	+	procedure DoAfterDelete; override;
398		procedure DoBeforeEdit; override;
399	+	procedure DoAfterEdit; override;
400		procedure DoBeforeInsert; override;
401		procedure DoAfterInsert; override;
402	+	procedure DoBeforeClose; override;
403	+	procedure DoBeforeOpen; override;
404		procedure DoBeforePost; override;
405	+	procedure DoAfterPost; override;
406		procedure FreeRecordBuffer(var Buffer: PChar); override;
407		procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
408		function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
409		function GetCanModify: Boolean; override;
410		function GetDataSource: TDataSource; override;
411	+	function GetDBAliasName(FieldNo: integer): string;
412	+	function GetFieldDefFromAlias(aliasName: string): TFieldDef;
413		function GetFieldClass(FieldType: TFieldType): TFieldClass; override;
414		function GetRecNo: Integer; override;
415		function GetRecord(Buffer: PChar; GetMode: TGetMode;
416		DoCheck: Boolean): TGetResult; override;
417		function GetRecordCount: Integer; override;
418		function GetRecordSize: Word; override;
419	+	procedure InternalAutoCommit;
420		procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override;
421		procedure InternalCancel; override;
422		procedure InternalClose; override;
#	Line 385 | Line 434 | type
434		procedure InternalSetFieldData(Field: TField; Buffer: Pointer); virtual;
435		procedure InternalSetToRecord(Buffer: PChar); override;
436		function IsCursorOpen: Boolean; override;
437	+	procedure Loaded; override;
438		procedure ReQuery;
439		procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
440		procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
441		procedure SetCachedUpdates(Value: Boolean);
442		procedure SetDataSource(Value: TDataSource);
443	+	procedure SetGenerateParamNames(AValue: Boolean); virtual;
444		procedure SetFieldData(Field : TField; Buffer : Pointer); override;
445		procedure SetFieldData(Field : TField; Buffer : Pointer;
446		NativeFormat : Boolean); overload; override;
#	Line 397 | Line 448 | type
448
449		protected
450		{Likely to be made public by descendant classes}
451	+	property AutoCommit: TIBAutoCommit read FAutoCommit write FAutoCommit default acDisabled;
452		property SQLParams: TIBXSQLDA read GetSQLParams;
453		property Params: TIBXSQLDA read GetSQLParams;
454		property InternalPrepared: Boolean read FInternalPrepared;
#	Line 420 | Line 472 | type
472		property ModifySQL: TStrings read GetModifySQL write SetModifySQL;
473		property UpdateMode: TUpdateMode read FUpdateMode write SetUpdateMode default upWhereAll;
474		property ParamCheck: Boolean read FParamCheck write FParamCheck default True;
475	+	property Parser: TSelectSQLParser read GetParser;
476	+	property BaseSQLSelect: TStrings read FBaseSQLSelect;
477
478		property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect
479		write FBeforeDatabaseDisconnect;
#	Line 433 | Line 487 | type
487		write FAfterTransactionEnd;
488		property TransactionFree: TNotifyEvent read FTransactionFree
489		write FTransactionFree;
490	+	property OnValidatePost: TOnValidatePost read FOnValidatePost write FOnValidatePost;
491
492		public
493		constructor Create(AOwner: TComponent); override;
#	Line 440 | Line 495 | type
495		procedure ApplyUpdates;
496		function CachedUpdateStatus: TCachedUpdateStatus;
497		procedure CancelUpdates;
498	+	function GetFieldPosition(AliasName: string): integer;
499		procedure FetchAll;
500		function LocateNext(const KeyFields: string; const KeyValues: Variant;
501		Options: TLocateOptions): Boolean;
502		procedure RecordModified(Value: Boolean);
503		procedure RevertRecord;
504		procedure Undelete;
505	+	procedure ResetParser;
506	+	function HasParser: boolean;
507
508		{ TDataSet support methods }
509		function BookmarkValid(Bookmark: TBookmark): Boolean; override;
#	Line 456 | Line 514 | type
514		function GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; overload; (*override;*)
515		function GetFieldData(Field : TField; Buffer : Pointer;
516		NativeFormat : Boolean) : Boolean; overload; override;
517	+	property GenerateParamNames: Boolean read FGenerateParamNames write SetGenerateParamNames;
518		function Locate(const KeyFields: string; const KeyValues: Variant;
519		Options: TLocateOptions): Boolean; override;
520		function Lookup(const KeyFields: string; const KeyValues: Variant;
521		const ResultFields: string): Variant; override;
522		function UpdateStatus: TUpdateStatus; override;
523		function IsSequenced: Boolean; override;
524	+	procedure Post; override;
525		function ParamByName(ParamName: String): TIBXSQLVAR;
526		property DBHandle: PISC_DB_HANDLE read GetDBHandle;
527		property TRHandle: PISC_TR_HANDLE read GetTRHandle;
#	Line 469 | Line 529 | type
529		property UpdatesPending: Boolean read FUpdatesPending;
530		property UpdateRecordTypes: TIBUpdateRecordTypes read FUpdateRecordTypes
531		write SetUpdateRecordTypes;
532	+	property DataSetCloseAction: TDataSetCloseAction
533	+	read FDataSetCloseAction write FDataSetCloseAction;
534
535		published
536		property Database: TIBDatabase read GetDatabase write SetDatabase;
#	Line 507 | Line 569 | type
569		write FOnUpdateRecord;
570		end;
571
572	<	TIBDataSet = class(TIBCustomDataSet)
572	>	TIBParserDataSet = class(TIBCustomDataSet)
573	>	public
574	>	property Parser;
575	>	end;
576	>
577	>	TIBDataSet = class(TIBParserDataSet)
578		private
579		function GetPrepared: Boolean;
580
#	Line 532 | Line 599 | type
599		property QModify;
600		property StatementType;
601		property SelectStmtHandle;
602	+	property BaseSQLSelect;
603
604		published
605		{ TIBCustomDataSet }
606	+	property AutoCommit;
607		property BufferChunks;
608		property CachedUpdates;
609		property DeleteSQL;
#	Line 543 | Line 612 | type
612		property SelectSQL;
613		property ModifySQL;
614		property GeneratorField;
615	+	property GenerateParamNames;
616		property ParamCheck;
617		property UniDirectional;
618		property Filtered;
619	+	property DataSetCloseAction;
620
621		property BeforeDatabaseDisconnect;
622		property AfterDatabaseDisconnect;
#	Line 581 | Line 652 | type
652		property OnFilterRecord;
653		property OnNewRecord;
654		property OnPostError;
655	+	property OnValidatePost;
656		end;
657
658		{ TIBDSBlobStream }
659		TIBDSBlobStream = class(TStream)
660	+	private
661	+	FHasWritten: boolean;
662		protected
663		FField: TField;
664		FBlobStream: TIBBlobStream;
665		public
666		constructor Create(AField: TField; ABlobStream: TIBBlobStream;
667		Mode: TBlobStreamMode);
668	+	destructor Destroy; override;
669		function Read(var Buffer; Count: Longint): Longint; override;
670		function Seek(Offset: Longint; Origin: Word): Longint; override;
671		procedure SetSize(NewSize: Longint); override;
#	Line 678 | Line 753 | type
753		NextRelation : TRelationNode;
754		end;
755
756	+	{ TIBControlLink }
757	+
758	+	destructor TIBControlLink.Destroy;
759	+	begin
760	+	IBDataSet := nil;
761	+	inherited Destroy;
762	+	end;
763	+
764	+	procedure TIBControlLink.UpdateParams(Sender: TObject);
765	+	begin
766	+
767	+	end;
768	+
769	+	procedure TIBControlLink.UpdateSQL(Sender: TObject);
770	+	begin
771	+
772	+	end;
773	+
774	+	procedure TIBControlLink.SetIBDataSet(AValue: TIBCustomDataSet);
775	+	begin
776	+	if FTIBDataSet = AValue then Exit;
777	+	if IBDataSet <> nil then
778	+	IBDataSet.UnRegisterIBLink(self);
779	+	FTIBDataSet := AValue;
780	+	if IBDataSet <> nil then
781	+	IBDataSet.RegisterIBLink(self);
782	+	end;
783	+
784
785		{ TIBStringField}
786
787	<	constructor TIBStringField.Create(AOwner: TComponent);
787	>	constructor TIBStringField.create(AOwner: TComponent);
788		begin
789		inherited Create(AOwner);
790		end;
#	Line 738 | Line 841 | begin
841		end;
842		end;
843
844	+	procedure TIBStringField.SetSize(AValue: Integer);
845	+	var FieldSize: integer;
846	+	begin
847	+	if csLoading in ComponentState then
848	+	FInitialised := true;
849	+	if FInitialised then
850	+	inherited SetSize(AValue)
851	+	else
852	+	begin
853	+	{IBCustomDataSet encodes the CharWidth size in the size}
854	+	FieldSize := AValue div 4;
855	+	inherited SetSize(FieldSize);
856	+	DisplayWidth := FieldSize div ((AValue mod 4) + 1);
857	+	FInitialised := true;
858	+	end;
859	+	end;
860	+
861		{ TIBBCDField }
862
863		constructor TIBBCDField.Create(AOwner: TComponent);
#	Line 835 | Line 955 | begin
955		CheckIBLoaded;
956		FIBLoaded := True;
957		FBase := TIBBase.Create(Self);
958	+	FIBLinks := TList.Create;
959		FCurrentRecord := -1;
960		FDeletedRecords := 0;
961		FUniDirectional := False;
#	Line 859 | Line 980 | begin
980		FQModify.GoToFirstRecordOnExecute := False;
981		FUpdateRecordTypes := [cusUnmodified, cusModified, cusInserted];
982		FParamCheck := True;
983	+	FGenerateParamNames := False;
984		FForcedRefresh := False;
985	+	FAutoCommit:= acDisabled;
986	+	FDataSetCloseAction := dcDiscardChanges;
987		{Bookmark Size is Integer for IBX}
988		BookmarkSize := SizeOf(Integer);
989		FBase.BeforeDatabaseDisconnect := DoBeforeDatabaseDisconnect;
#	Line 873 | Line 997 | begin
997		else
998		if AOwner is TIBTransaction then
999		Transaction := TIBTransaction(AOwner);
1000	+	FBaseSQLSelect := TStringList.Create;
1001		end;
1002
1003		destructor TIBCustomDataSet.Destroy;
#	Line 884 | Line 1009 | begin
1009		FDataLink.Free;
1010		FBase.Free;
1011		ClearBlobCache;
1012	+	ClearIBLinks;
1013	+	FIBLinks.Free;
1014		FBlobStreamList.Free;
1015		FreeMem(FBufferCache);
1016		FBufferCache := nil;
#	Line 893 | Line 1020 | begin
1020		FOldCacheSize := 0;
1021		FMappedFieldPosition := nil;
1022		end;
1023	+	if assigned(FBaseSQLSelect) then FBaseSQLSelect.Free;
1024	+	if assigned(FParser) then FParser.Free;
1025		inherited Destroy;
1026		end;
1027
#	Line 1136 | Line 1265 | begin
1265		end;
1266		end;
1267
1268	+	function TIBCustomDataSet.GetFieldPosition(AliasName: string): integer;
1269	+	var i: integer;
1270	+	Prepared: boolean;
1271	+	begin
1272	+	Result := 0;
1273	+	Prepared := FInternalPrepared;
1274	+	if not Prepared then
1275	+	InternalPrepare;
1276	+	try
1277	+	for i := 0 to Length(FAliasNameList) - 1 do
1278	+	if FAliasNameList[i] = AliasName then
1279	+	begin
1280	+	Result := i + 1;
1281	+	Exit
1282	+	end;
1283	+	finally
1284	+	if not Prepared then
1285	+	InternalUnPrepare;
1286	+	end;
1287	+	end;
1288	+
1289		procedure TIBCustomDataSet.ActivateConnection;
1290		begin
1291		if not Assigned(Database) then
#	Line 1196 | Line 1346 | begin
1346		IBError(ibxeDatasetClosed, [nil]);
1347		end;
1348
1349	+	function TIBCustomDataSet.CreateParser: TSelectSQLParser;
1350	+	begin
1351	+	Result := TSelectSQLParser.Create(self,FBaseSQLSelect);
1352	+	Result.OnSQLChanging := SQLChanging
1353	+	end;
1354	+
1355		procedure TIBCustomDataSet.CheckNotUniDirectional;
1356		begin
1357		if UniDirectional then
#	Line 1299 | Line 1455 | begin
1455		FDatabaseFree(Sender);
1456		end;
1457
1458	<	procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject);
1458	>	procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject;
1459	>	Action: TTransactionAction);
1460		begin
1461	<	if Active then
1462	<	Active := False;
1461	>	FCloseAction := Action;
1462	>	FInTransactionEnd := true;
1463	>	try
1464	>	if Active then
1465	>	Active := False;
1466	>	finally
1467	>	FInTransactionEnd := false;
1468	>	end;
1469		if FQSelect <> nil then
1470		FQSelect.FreeHandle;
1471		if FQDelete <> nil then
#	Line 1340 | Line 1503 | var
1503		LocalData: Pointer;
1504		LocalDate, LocalDouble: Double;
1505		LocalInt: Integer;
1506	+	LocalBool: wordBool;
1507		LocalInt64: Int64;
1508		LocalCurrency: Currency;
1509		FieldsLoaded: Integer;
#	Line 1484 | Line 1648 | begin
1648		end;
1649		end;
1650		end;
1651	+	SQL_BOOLEAN:
1652	+	begin
1653	+	LocalBool:= false;
1654	+	rdFields[j].fdDataSize := SizeOf(wordBool);
1655	+	if RecordNumber >= 0 then
1656	+	LocalBool := Qry.Current[i].AsBoolean;
1657	+	LocalData := PChar(@LocalBool);
1658	+	end;
1659		else { SQL_TEXT, SQL_BLOB, SQL_ARRAY, SQL_QUAD }
1660		begin
1661		rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
#	Line 1755 | Line 1927 | end;
1927		procedure TIBCustomDataSet.InternalRefreshRow;
1928		var
1929		Buff: PChar;
1758	–	SetCursor: Boolean;
1930		ofs: DWORD;
1931		Qry: TIBSQL;
1932		begin
1933	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1763	<	if SetCursor then
1764	<	Screen.Cursor := crHourGlass;
1933	>	FBase.SetCursor;
1934		try
1935		Buff := GetActiveBuf;
1936		if CanRefresh then
#	Line 1805 | Line 1974 | begin
1974		else
1975		IBError(ibxeCannotRefresh, [nil]);
1976		finally
1977	<	if SetCursor and (Screen.Cursor = crHourGlass) then
1809	<	Screen.Cursor := crDefault;
1977	>	FBase.RestoreCursor;
1978		end;
1979		end;
1980
#	Line 1877 | Line 2045 | end;
2045
2046		procedure TIBCustomDataSet.InternalPrepare;
2047		var
1880	–	SetCursor: Boolean;
2048		DidActivate: Boolean;
2049		begin
2050		if FInternalPrepared then
2051		Exit;
2052		DidActivate := False;
2053	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1887	<	if SetCursor then
1888	<	Screen.Cursor := crHourGlass;
2053	>	FBase.SetCursor;
2054		try
2055		ActivateConnection;
2056		DidActivate := ActivateTransaction;
2057		FBase.CheckDatabase;
2058		FBase.CheckTransaction;
2059	+	if HasParser and (FParser.SQLText <> FQSelect.SQL.Text) then
2060	+	FQSelect.SQL.Text := FParser.SQLText;
2061	+	//   writeln( FQSelect.SQL.Text);
2062		if FQSelect.SQL.Text <> '' then
2063		begin
2064		if not FQSelect.Prepared then
2065		begin
2066	+	FQSelect.GenerateParamNames := FGenerateParamNames;
2067		FQSelect.ParamCheck := ParamCheck;
2068		FQSelect.Prepare;
2069		end;
2070	+	FQDelete.GenerateParamNames := FGenerateParamNames;
2071		if (Trim(FQDelete.SQL.Text) <> '') and (not FQDelete.Prepared) then
2072		FQDelete.Prepare;
2073	+	FQInsert.GenerateParamNames := FGenerateParamNames;
2074		if (Trim(FQInsert.SQL.Text) <> '') and (not FQInsert.Prepared) then
2075		FQInsert.Prepare;
2076	+	FQRefresh.GenerateParamNames := FGenerateParamNames;
2077		if (Trim(FQRefresh.SQL.Text) <> '') and (not FQRefresh.Prepared) then
2078		FQRefresh.Prepare;
2079	+	FQModify.GenerateParamNames := FGenerateParamNames;
2080		if (Trim(FQModify.SQL.Text) <> '') and (not FQModify.Prepared) then
2081		FQModify.Prepare;
2082		FInternalPrepared := True;
#	Line 1913 | Line 2086 | begin
2086		finally
2087		if DidActivate then
2088		DeactivateTransaction;
2089	<	if SetCursor and (Screen.Cursor = crHourGlass) then
1917	<	Screen.Cursor := crDefault;
2089	>	FBase.RestoreCursor;
2090		end;
2091		end;
2092
#	Line 2105 | Line 2277 | begin
2277		SQL_TIMESTAMP:
2278		Qry.Params[i].AsDateTime :=
2279		TimeStampToDateTime(MSecsToTimeStamp(trunc(PDouble(data)^)));
2280	+	SQL_BOOLEAN:
2281	+	Qry.Params[i].AsBoolean := PWordBool(data)^;
2282		end;
2283		end;
2284		end;
#	Line 2130 | Line 2304 | begin
2304		begin
2305		Disconnect;
2306		FQSelect.SQL.Assign(Value);
2307	+	FBaseSQLSelect.assign(Value);
2308		end;
2309		end;
2310
#	Line 2190 | Line 2365 | begin
2365		end;
2366		end;
2367
2368	+	procedure TIBCustomDataSet.RegisterIBLink(Sender: TIBControlLink);
2369	+	begin
2370	+	if FIBLinks.IndexOf(Sender) = -1 then
2371	+	FIBLinks.Add(Sender);
2372	+	end;
2373	+
2374
2375		procedure TIBCustomDataSet.SQLChanging(Sender: TObject);
2376		begin
2377	<	if FOpen then
2378	<	InternalClose;
2377	>	Active := false;
2378	>	{  if FOpen then
2379	>	InternalClose;}
2380		if FInternalPrepared then
2381		InternalUnPrepare;
2382	+	FieldDefs.Clear;
2383	+	FieldDefs.Updated := false;
2384		end;
2385
2386		{ I can "undelete" uninserted records (make them "inserted" again).
#	Line 2225 | Line 2409 | begin
2409		end;
2410		end;
2411
2412	+	procedure TIBCustomDataSet.UnRegisterIBLink(Sender: TIBControlLink);
2413	+	begin
2414	+	FIBLinks.Remove(Sender);
2415	+	end;
2416	+
2417		function TIBCustomDataSet.UpdateStatus: TUpdateStatus;
2418		begin
2419		if Active then
#	Line 2454 | Line 2643 | begin
2643		inherited DoBeforeDelete;
2644		end;
2645
2646	+	procedure TIBCustomDataSet.DoAfterDelete;
2647	+	begin
2648	+	inherited DoAfterDelete;
2649	+	FBase.DoAfterDelete(self);
2650	+	InternalAutoCommit;
2651	+	end;
2652	+
2653		procedure TIBCustomDataSet.DoBeforeEdit;
2654		var
2655		Buff: PRecordData;
#	Line 2468 | Line 2664 | begin
2664		inherited DoBeforeEdit;
2665		end;
2666
2667	+	procedure TIBCustomDataSet.DoAfterEdit;
2668	+	begin
2669	+	inherited DoAfterEdit;
2670	+	FBase.DoAfterEdit(self);
2671	+	end;
2672	+
2673		procedure TIBCustomDataSet.DoBeforeInsert;
2674		begin
2675		if not CanInsert then
#	Line 2480 | Line 2682 | begin
2682		if GeneratorField.ApplyOnEvent = gaeOnNewRecord then
2683		GeneratorField.Apply;
2684		inherited DoAfterInsert;
2685	+	FBase.DoAfterInsert(self);
2686	+	end;
2687	+
2688	+	procedure TIBCustomDataSet.DoBeforeClose;
2689	+	begin
2690	+	inherited DoBeforeClose;
2691	+	if State in [dsInsert,dsEdit] then
2692	+	begin
2693	+	if FInTransactionEnd and (FCloseAction = TARollback) then
2694	+	Exit;
2695	+
2696	+	if DataSetCloseAction = dcSaveChanges then
2697	+	Post;
2698	+	{Note this can fail with an exception e.g. due to
2699	+	database validation error. In which case the dataset remains open }
2700	+	end;
2701	+	end;
2702	+
2703	+	procedure TIBCustomDataSet.DoBeforeOpen;
2704	+	var i: integer;
2705	+	begin
2706	+	if assigned(FParser) then
2707	+	FParser.Reset;
2708	+	for i := 0 to FIBLinks.Count - 1 do
2709	+	TIBControlLink(FIBLinks[i]).UpdateSQL(self);
2710	+	inherited DoBeforeOpen;
2711	+	for i := 0 to FIBLinks.Count - 1 do
2712	+	TIBControlLink(FIBLinks[i]).UpdateParams(self);
2713		end;
2714
2715		procedure TIBCustomDataSet.DoBeforePost;
#	Line 2490 | Line 2720 | begin
2720		GeneratorField.Apply
2721		end;
2722
2723	+	procedure TIBCustomDataSet.DoAfterPost;
2724	+	begin
2725	+	inherited DoAfterPost;
2726	+	FBase.DoAfterPost(self);
2727	+	InternalAutoCommit;
2728	+	end;
2729	+
2730		procedure TIBCustomDataSet.FetchAll;
2731		var
2495	–	SetCursor: Boolean;
2732		{$IF FPC_FULLVERSION >= 20700 }
2733		CurBookmark: TBookmark;
2734		{$ELSE}
2735		CurBookmark: string;
2736		{$ENDIF}
2737		begin
2738	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
2739	<	if SetCursor then
2504	<	Screen.Cursor := crHourGlass;
2505	<	try
2738	>	FBase.SetCursor;
2739	>	try
2740		if FQSelect.EOF or not FQSelect.Open then
2741		exit;
2742		DisableControls;
#	Line 2514 | Line 2748 | begin
2748		EnableControls;
2749		end;
2750		finally
2751	<	if SetCursor and (Screen.Cursor = crHourGlass) then
2518	<	Screen.Cursor := crDefault;
2751	>	FBase.RestoreCursor;
2752		end;
2753		end;
2754
#	Line 2563 | Line 2796 | begin
2796		result := FDataLink.DataSource;
2797		end;
2798
2799	+	function TIBCustomDataSet.GetDBAliasName(FieldNo: integer): string;
2800	+	begin
2801	+	Result := FAliasNameMap[FieldNo-1]
2802	+	end;
2803	+
2804	+	function TIBCustomDataSet.GetFieldDefFromAlias(aliasName: string): TFieldDef;
2805	+	var
2806	+	i: integer;
2807	+	begin
2808	+	Result := nil;
2809	+	for i := 0 to Length(FAliasNameMap) - 1 do
2810	+	if FAliasNameMap[i] = aliasName then
2811	+	begin
2812	+	Result := FieldDefs[i];
2813	+	Exit
2814	+	end;
2815	+	end;
2816	+
2817		function TIBCustomDataSet.GetFieldClass(FieldType: TFieldType): TFieldClass;
2818		begin
2819		Result := DefaultFieldClasses[FieldType];
#	Line 2603 | Line 2854 | begin
2854		Data := Buff + CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs;
2855		if (fdDataType = SQL_VARYING) or (fdDataType = SQL_TEXT) then
2856		begin
2857	<	if fdDataLength <= Field.Size then
2857	>	if fdDataLength < Field.DataSize then
2858		begin
2859		Move(Data^, Buffer^, fdDataLength);
2860		PChar(Buffer)[fdDataLength] := #0;
#	Line 2652 | Line 2903 | begin
2903		if not Accept and (GetMode = gmCurrent) then
2904		GetMode := gmPrior;
2905		except
2906	<	//        Application.HandleException(Self);
2906	>	//        FBase.HandleException(Self);
2907		end;
2908		end;
2909		RestoreState(SaveState);
#	Line 2746 | Line 2997 | begin
2997		result := FRecordBufferSize;
2998		end;
2999
3000	+	procedure TIBCustomDataSet.InternalAutoCommit;
3001	+	begin
3002	+	with Transaction do
3003	+	if InTransaction and (FAutoCommit = acCommitRetaining) then
3004	+	begin
3005	+	if CachedUpdates then ApplyUpdates;
3006	+	CommitRetaining;
3007	+	end;
3008	+	end;
3009	+
3010		procedure TIBCustomDataSet.InternalAddRecord(Buffer: Pointer; Append: Boolean);
3011		begin
3012		CheckEditState;
#	Line 2823 | Line 3084 | end;
3084		procedure TIBCustomDataSet.InternalDelete;
3085		var
3086		Buff: PChar;
2826	–	SetCursor: Boolean;
3087		begin
3088	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
2829	<	if SetCursor then
2830	<	Screen.Cursor := crHourGlass;
3088	>	FBase.SetCursor;
3089		try
3090		Buff := GetActiveBuf;
3091		if CanDelete then
#	Line 2852 | Line 3110 | begin
3110		end else
3111		IBError(ibxeCannotDelete, [nil]);
3112		finally
3113	<	if SetCursor and (Screen.Cursor = crHourGlass) then
2856	<	Screen.Cursor := crDefault;
3113	>	FBase.RestoreCursor;
3114		end;
3115		end;
3116
#	Line 2869 | Line 3126 | end;
3126
3127		procedure TIBCustomDataSet.InternalHandleException;
3128		begin
3129	<	Application.HandleException(Self)
3129	>	FBase.HandleException(Self)
3130		end;
3131
3132		procedure TIBCustomDataSet.InternalInitFieldDefs;
3133	+	begin
3134	+	if not InternalPrepared then
3135	+	begin
3136	+	InternalPrepare;
3137	+	exit;
3138	+	end;
3139	+	FieldDefsFromQuery(FQSelect);
3140	+	end;
3141	+
3142	+	procedure TIBCustomDataSet.FieldDefsFromQuery(SourceQuery: TIBSQL);
3143		const
3144		DefaultSQL = 'Select F.RDB$COMPUTED_BLR, ' + {do not localize}
3145		'F.RDB$DEFAULT_VALUE, R.RDB$FIELD_NAME ' + {do not localize}
#	Line 2884 | Line 3151 | const
3151		var
3152		FieldType: TFieldType;
3153		FieldSize: Word;
3154	+	CharSetSize: integer;
3155		FieldNullable : Boolean;
3156		i, FieldPosition, FieldPrecision: Integer;
3157	<	FieldAliasName: string;
3157	>	FieldAliasName, DBAliasName: string;
3158		RelationName, FieldName: string;
3159		Query : TIBSQL;
3160		FieldIndex: Integer;
#	Line 2986 | Line 3254 | var
3254		end;
3255
3256		begin
2989	–	if not InternalPrepared then
2990	–	begin
2991	–	InternalPrepare;
2992	–	exit;
2993	–	end;
3257		FRelationNodes := TRelationNode.Create;
3258		FNeedsRefresh := False;
3259		Database.InternalTransaction.StartTransaction;
#	Line 3001 | Line 3264 | begin
3264		FieldDefs.BeginUpdate;
3265		FieldDefs.Clear;
3266		FieldIndex := 0;
3267	<	if (Length(FMappedFieldPosition) < FQSelect.Current.Count) then
3268	<	SetLength(FMappedFieldPosition, FQSelect.Current.Count);
3267	>	if (Length(FMappedFieldPosition) < SourceQuery.Current.Count) then
3268	>	SetLength(FMappedFieldPosition, SourceQuery.Current.Count);
3269		Query.SQL.Text := DefaultSQL;
3270		Query.Prepare;
3271	<	for i := 0 to FQSelect.Current.Count - 1 do
3272	<	with FQSelect.Current[i].Data^ do
3271	>	SetLength(FAliasNameMap, SourceQuery.Current.Count);
3272	>	SetLength(FAliasNameList, SourceQuery.Current.Count);
3273	>	for i := 0 to SourceQuery.Current.Count - 1 do
3274	>	with SourceQuery.Current[i].Data^ do
3275		begin
3276		{ Get the field name }
3277	<	SetString(FieldAliasName, aliasname, aliasname_length);
3277	>	FieldAliasName := SourceQuery.Current[i].Name;
3278	>	SetString(DBAliasName, aliasname, aliasname_length);
3279		SetString(RelationName, relname, relname_length);
3280		SetString(FieldName, sqlname, sqlname_length);
3281	+	FAliasNameList[i] := DBAliasName;
3282		FieldSize := 0;
3283		FieldPrecision := 0;
3284	<	FieldNullable := FQSelect.Current[i].IsNullable;
3284	>	FieldNullable := SourceQuery.Current[i].IsNullable;
3285		case sqltype and not 1 of
3286		{ All VARCHAR's must be converted to strings before recording
3287		their values }
3288		SQL_VARYING, SQL_TEXT:
3289		begin
3290	<	FieldSize := sqllen;
3290	>	CharSetSize := FBase.GetCharSetSize(sqlsubtype and $FF);
3291	>	{FieldSize is encoded for strings - see TIBStringField.SetSize for decode}
3292	>	FieldSize := sqllen * 4 + (CharSetSize - 1);
3293		FieldType := ftString;
3294		end;
3295		{ All Doubles/Floats should be cast to doubles }
#	Line 3089 | Line 3358 | begin
3358		FieldSize := sizeof (TISC_QUAD);
3359		FieldType := ftUnknown;
3360		end;
3361	+	SQL_BOOLEAN:
3362	+	FieldType:= ftBoolean;
3363		else
3364		FieldType := ftUnknown;
3365		end;
#	Line 3100 | Line 3371 | begin
3371		with FieldDefs.AddFieldDef do
3372		begin
3373		Name := FieldAliasName;
3374	<	(*           FieldNo := FieldPosition;*)
3374	>	FAliasNameMap[FieldNo-1] := DBAliasName;
3375		DataType := FieldType;
3376		Size := FieldSize;
3377		Precision := FieldPrecision;
#	Line 3185 | Line 3456 | begin
3456		else case cur_field.DataType of
3457		ftString:
3458		cur_param.AsString := cur_field.AsString;
3459	<	ftBoolean, ftSmallint, ftWord:
3459	>	ftBoolean:
3460	>	cur_param.AsBoolean := cur_field.AsBoolean;
3461	>	ftSmallint, ftWord:
3462		cur_param.AsShort := cur_field.AsInteger;
3463		ftInteger:
3464		cur_param.AsLong := cur_field.AsInteger;
#	Line 3238 | Line 3511 | begin
3511		end;
3512
3513		procedure TIBCustomDataSet.InternalOpen;
3241	–	var
3242	–	SetCursor: Boolean;
3514
3515		function RecordDataLength(n: Integer): Long;
3516		begin
#	Line 3247 | Line 3518 | var
3518		end;
3519
3520		begin
3521	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3251	<	if SetCursor then
3252	<	Screen.Cursor := crHourGlass;
3521	>	FBase.SetCursor;
3522		try
3523		ActivateConnection;
3524		ActivateTransaction;
#	Line 3310 | Line 3579 | begin
3579		else
3580		FQSelect.ExecQuery;
3581		finally
3582	<	if SetCursor and (Screen.Cursor = crHourGlass) then
3314	<	Screen.Cursor := crDefault;
3582	>	FBase.RestoreCursor;
3583		end;
3584		end;
3585
#	Line 3319 | Line 3587 | procedure TIBCustomDataSet.InternalPost;
3587		var
3588		Qry: TIBSQL;
3589		Buff: PChar;
3322	–	SetCursor: Boolean;
3590		bInserting: Boolean;
3591		begin
3592	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3326	<	if SetCursor then
3327	<	Screen.Cursor := crHourGlass;
3592	>	FBase.SetCursor;
3593		try
3594		Buff := GetActiveBuf;
3595		CheckEditState;
#	Line 3362 | Line 3627 | begin
3627		if bInserting then
3628		Inc(FRecordCount);
3629		finally
3630	<	if SetCursor and (Screen.Cursor = crHourGlass) then
3366	<	Screen.Cursor := crDefault;
3630	>	FBase.RestoreCursor;
3631		end;
3632		end;
3633
#	Line 3383 | Line 3647 | begin
3647		result := FOpen;
3648		end;
3649
3650	+	procedure TIBCustomDataSet.Loaded;
3651	+	begin
3652	+	if assigned(FQSelect) then
3653	+	FBaseSQLSelect.assign(FQSelect.SQL);
3654	+	inherited Loaded;
3655	+	end;
3656	+
3657	+	procedure TIBCustomDataSet.Post;
3658	+	var CancelPost: boolean;
3659	+	begin
3660	+	CancelPost := false;
3661	+	if assigned(FOnValidatePost) then
3662	+	OnValidatePost(self,CancelPost);
3663	+	if CancelPost then
3664	+	Cancel
3665	+	else
3666	+	inherited Post;
3667	+	end;
3668	+
3669		function TIBCustomDataSet.Locate(const KeyFields: string; const KeyValues: Variant;
3670		Options: TLocateOptions): Boolean;
3671		var
#	Line 3465 | Line 3748 | end;
3748		procedure TIBCustomDataSet.InternalSetFieldData(Field: TField; Buffer: Pointer);
3749		var
3750		Buff, TmpBuff: PChar;
3751	+	MappedFieldPos: integer;
3752		begin
3753		Buff := GetActiveBuf;
3754		if Field.FieldNo < 0 then
#	Line 3481 | Line 3765 | begin
3765		begin
3766		{ If inserting, Adjust record position }
3767		AdjustRecordOnInsert(Buff);
3768	<	if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and
3769	<	(FMappedFieldPosition[Field.FieldNo - 1] <= rdFieldCount) then
3768	>	MappedFieldPos := FMappedFieldPosition[Field.FieldNo - 1];
3769	>	if (MappedFieldPos > 0) and
3770	>	(MappedFieldPos <= rdFieldCount) then
3771		begin
3772		Field.Validate(Buffer);
3773		if (Buffer = nil) or
3774		(Field is TIBStringField) and (PChar(Buffer)[0] = #0) then
3775	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull := True
3775	>	rdFields[MappedFieldPos].fdIsNull := True
3776		else begin
3777	<	Move(Buffer^, Buff[rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs],
3778	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataSize);
3779	<	if (rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_TEXT) or
3780	<	(rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_VARYING) then
3781	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataLength := StrLen(PChar(Buffer));
3782	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull := False;
3777	>	Move(Buffer^, Buff[rdFields[MappedFieldPos].fdDataOfs],
3778	>	rdFields[MappedFieldPos].fdDataSize);
3779	>	if (rdFields[MappedFieldPos].fdDataType = SQL_TEXT) or
3780	>	(rdFields[MappedFieldPos].fdDataType = SQL_VARYING) then
3781	>	rdFields[MappedFieldPos].fdDataLength := StrLen(PChar(Buffer));
3782	>	rdFields[MappedFieldPos].fdIsNull := False;
3783		if rdUpdateStatus = usUnmodified then
3784		begin
3785		if CachedUpdates then
#	Line 3582 | Line 3867 | begin
3867		FillChar(Buffer[FRecordSize], CalcFieldsSize, 0);
3868		end;
3869
3870	+	procedure TIBCustomDataSet.ClearIBLinks;
3871	+	var i: integer;
3872	+	begin
3873	+	for i := FIBLinks.Count - 1 downto 0 do
3874	+	TIBControlLink(FIBLinks[i]).IBDataSet := nil;
3875	+	end;
3876	+
3877
3878		procedure TIBCustomDataSet.InternalUnPrepare;
3879		begin
#	Line 3589 | Line 3881 | begin
3881		begin
3882		CheckDatasetClosed;
3883		FieldDefs.Clear;
3884	+	FieldDefs.Updated := false;
3885		FInternalPrepared := False;
3886	+	Setlength(FAliasNameList,0);
3887		end;
3888		end;
3889
3890		procedure TIBCustomDataSet.InternalExecQuery;
3891		var
3892		DidActivate: Boolean;
3599	–	SetCursor: Boolean;
3893		begin
3894		DidActivate := False;
3895	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3603	<	if SetCursor then
3604	<	Screen.Cursor := crHourGlass;
3895	>	FBase.SetCursor;
3896		try
3897		ActivateConnection;
3898		DidActivate := ActivateTransaction;
#	Line 3618 | Line 3909 | begin
3909		finally
3910		if DidActivate then
3911		DeactivateTransaction;
3912	<	if SetCursor and (Screen.Cursor = crHourGlass) then
3622	<	Screen.Cursor := crDefault;
3912	>	FBase.RestoreCursor;
3913		end;
3914		end;
3915
#	Line 3628 | Line 3918 | begin
3918		Result := FQSelect.Handle;
3919		end;
3920
3921	+	function TIBCustomDataSet.GetParser: TSelectSQLParser;
3922	+	begin
3923	+	if not assigned(FParser) then
3924	+	FParser := CreateParser;
3925	+	Result := FParser
3926	+	end;
3927	+
3928	+	procedure TIBCustomDataSet.ResetParser;
3929	+	begin
3930	+	if assigned(FParser) then
3931	+	begin
3932	+	FParser.Free;
3933	+	FParser := nil;
3934	+	SQLChanging(nil)
3935	+	end;
3936	+	end;
3937	+
3938	+	function TIBCustomDataSet.HasParser: boolean;
3939	+	begin
3940	+	Result := not (csDesigning in ComponentState) and (FParser <> nil)
3941	+	end;
3942	+
3943	+	procedure TIBCustomDataSet.SetGenerateParamNames(AValue: Boolean);
3944	+	begin
3945	+	if FGenerateParamNames = AValue then Exit;
3946	+	FGenerateParamNames := AValue;
3947	+	Disconnect
3948	+	end;
3949	+
3950		procedure TIBCustomDataSet.InitRecord(Buffer: PChar);
3951		begin
3952		inherited InitRecord(Buffer);
#	Line 3962 | Line 4281 | begin
4281		FBlobStream.Truncate;
4282		end;
4283
4284	+	destructor TIBDSBlobStream.Destroy;
4285	+	begin
4286	+	if FHasWritten then
4287	+	TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
4288	+	inherited Destroy;
4289	+	end;
4290	+
4291		function TIBDSBlobStream.Read(var Buffer; Count: Longint): Longint;
4292		begin
4293		result := FBlobStream.Read(Buffer, Count);
#	Line 3984 | Line 4310 | begin
4310		TIBCustomDataSet(FField.DataSet).RecordModified(True);
4311		TBlobField(FField).Modified := true;
4312		result := FBlobStream.Write(Buffer, Count);
4313	<	TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
4313	>	FHasWritten := true;
4314	>	{  TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
4315	>	Removed as this caused a seek to beginning of the blob stream thus corrupting
4316	>	the blob stream. Moved to the destructor i.e. called after blob written}
4317		end;
4318
4319		{ TIBGenerator }

Diff Legend

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