ViewVC Help

View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing

root/public/ibx/trunk/runtime/nongui/IBCustomDataSet.pas

Comparing ibx/trunk/runtime/nongui/IBCustomDataSet.pas (file contents):
Revision 216 by tony, Thu Mar 15 17:21:13 2018 UTC vs.
Revision 291 by tony, Fri Apr 17 10:26:08 2020 UTC

#	Line 54 | Line 54 | uses
54		unix,
55		{$ENDIF}
56		SysUtils, Classes, IBDatabase, IBExternals, IB,  IBSQL, Db,
57	<	IBUtils, IBBlob, IBSQLParser, IBDatabaseInfo, fpTimer;
58	<
59	<	const
60	<	BufferCacheSize    =  1000;  { Allocate cache in this many record chunks}
61	<	UniCache           =  2;     { Uni-directional cache is 2 records big }
57	>	IBUtils, IBBlob, IBSQLParser, IBDatabaseInfo, IBTypes;
58
59		type
60		TIBCustomDataSet = class;
#	Line 88 | Line 84 | type
84		property RefreshSQL: TStrings read FRefreshSQL write SetRefreshSQL;
85		end;
86
91	–	TBlobDataArray = array[0..0] of TIBBlobStream;
92	–	PBlobDataArray = ^TBlobDataArray;
87		TIBArrayField = class;
88
89		{ TIBArray }
#	Line 108 | Line 102 | type
102		property ArrayIntf: IArray read FArray;
103		end;
104
111	–	TArrayDataArray = array [0..0] of TIBArray;
112	–	PArrayDataArray = ^TArrayDataArray;
113	–
114	–	{ TIBCustomDataSet }
115	–
116	–	TCachedUpdateStatus = (
117	–	cusUnmodified, cusModified, cusInserted,
118	–	cusDeleted, cusUninserted
119	–	);
120	–	TIBDBKey = record
121	–	DBKey: array[0..7] of Byte;
122	–	end;
123	–	PIBDBKey = ^TIBDBKey;
124	–
125	–	PFieldData = ^TFieldData;
126	–	TFieldData = record
127	–	fdIsNull: Boolean;
128	–	fdDataLength: Short;
129	–	end;
130	–
131	–	PColumnData = ^TColumnData;
132	–	TColumnData = record
133	–	fdDataType: Short;
134	–	fdDataScale: Short;
135	–	fdNullable: Boolean;
136	–	fdDataSize: Short;
137	–	fdDataOfs: Integer;
138	–	fdCodePage: TSystemCodePage;
139	–	end;
140	–
141	–	PFieldColumns = ^TFieldColumns;
142	–	TFieldColumns =  array[1..1] of TColumnData;
143	–
144	–	TRecordData = record
145	–	rdBookmarkFlag: TBookmarkFlag;
146	–	rdFieldCount: Short;
147	–	rdRecordNumber: Integer;
148	–	rdCachedUpdateStatus: TCachedUpdateStatus;
149	–	rdUpdateStatus: TUpdateStatus;
150	–	rdSavedOffset: DWORD;
151	–	rdDBKey: TIBDBKey;
152	–	rdFields: array[1..1] of TFieldData;
153	–	end;
154	–	PRecordData = ^TRecordData;
155	–
105		{ TIBArrayField }
106
107		TIBArrayField = class(TField)
#	Line 300 | Line 249 | type
249		private
250		FDataSet: TIBCustomDataSet;
251		FDelayTimerValue: integer;
252	<	FTimer: TFPTimer;
252	>	FTimer: TIBTimerInf;
253		procedure HandleRefreshTimer(Sender: TObject);
254		procedure SetDelayTimerValue(AValue: integer);
255		protected
#	Line 366 | Line 315 | type
315
316		TIBAutoCommit = (acDisabled, acCommitRetaining);
317
369	–	{ TIBCustomDataSet }
370	–
318		TIBUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApply, uaApplied);
319
320		TIBUpdateErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
#	Line 376 | Line 323 | type
323		TIBUpdateRecordEvent = procedure(DataSet: TDataSet; UpdateKind: TUpdateKind;
324		var UpdateAction: TIBUpdateAction) of object;
325
379	–	TIBUpdateRecordTypes = set of TCachedUpdateStatus;
380	–
326		TDataSetCloseAction = (dcDiscardChanges, dcSaveChanges);
327
328		TOnValidatePost = procedure (Sender: TObject; var CancelPost: boolean) of object;
329
330		TOnDeleteReturning = procedure (Sender: TObject; QryResults: IResults) of object;
331
332	+	{ TIBCustomDataSet }
333	+
334		TIBCustomDataSet = class(TDataset)
335		private
336	+	const
337	+	BufferCacheSize    =  1000;  { Allocate cache in this many record chunks}
338	+	UniCache           =  2;     { Uni-directional cache is 2 records big }
339	+
340	+	{Buffer cache constants for record selection}
341	+	FILE_BEGIN = 0;
342	+	FILE_CURRENT = 1;
343	+	FILE_END = 2;
344	+
345	+	{internal type declarations}
346	+	type
347	+	TArrayDataArray = array [0..0] of TIBArray;
348	+	PArrayDataArray = ^TArrayDataArray;
349	+
350	+	TBlobDataArray = array[0..0] of TIBBlobStream;
351	+	PBlobDataArray = ^TBlobDataArray;
352	+
353	+	TCachedUpdateStatus = (
354	+	cusUnmodified, cusModified, cusInserted,
355	+	cusDeleted, cusUninserted
356	+	);
357	+	TIBUpdateRecordTypes = set of TCachedUpdateStatus;
358	+
359	+	PFieldData = ^TFieldData;
360	+	TFieldData = record
361	+	fdIsNull: Boolean;
362	+	fdDataLength: Short;
363	+	end;
364	+
365	+	PColumnData = ^TColumnData;
366	+	TColumnData = record
367	+	fdDataType: Short;
368	+	fdDataScale: Short;
369	+	fdNullable: Boolean;
370	+	fdDataSize: Short;
371	+	fdDataOfs: Integer;
372	+	fdCodePage: TSystemCodePage;
373	+	end;
374	+
375	+	PFieldColumns = ^TFieldColumns;
376	+	TFieldColumns =  array[1..1] of TColumnData;
377	+
378	+	protected
379	+	type
380	+	TIBDBKey = record
381	+	DBKey: array[0..7] of Byte;
382	+	end;
383	+	PIBDBKey = ^TIBDBKey;
384	+
385	+	TRecordData = record
386	+	rdBookmarkFlag: TBookmarkFlag;
387	+	rdFieldCount: Short;
388	+	rdRecordNumber: Integer;
389	+	rdCachedUpdateStatus: TCachedUpdateStatus;
390	+	rdUpdateStatus: TUpdateStatus;
391	+	rdSavedOffset: DWORD;
392	+	rdDBKey: TIBDBKey;
393	+	rdFields: array[1..1] of TFieldData;
394	+	end;
395	+	PRecordData = ^TRecordData;
396	+
397	+	private
398		FAllowAutoActivateTransaction: Boolean;
399		FArrayFieldCount: integer;
400		FArrayCacheOffset: integer;
401		FAutoCommit: TIBAutoCommit;
402	+	FCaseSensitiveParameterNames: boolean;
403		FEnableStatistics: boolean;
404		FGenerateParamNames: Boolean;
405		FGeneratorField: TIBGenerator;
#	Line 465 | Line 475 | type
475		FieldIndex: integer; Buffer: PChar);
476		procedure InitModelBuffer(Qry: TIBSQL; Buffer: PChar);
477		function GetSelectStmtIntf: IStatement;
478	+	procedure SetCaseSensitiveParameterNames(AValue: boolean);
479		procedure SetUpdateMode(const Value: TUpdateMode);
480		procedure SetUpdateObject(Value: TIBDataSetUpdateObject);
481
#	Line 582 | Line 593 | type
593		procedure DoBeforeInsert; override;
594		procedure DoAfterInsert; override;
595		procedure DoBeforeClose; override;
585	–	procedure DoBeforeOpen; override;
596		procedure DoBeforePost; override;
597		procedure DoAfterPost; override;
598		procedure FreeRecordBuffer(var Buffer: PChar); override;
#	Line 643 | Line 653 | type
653		property SelectStmtHandle: IStatement read GetSelectStmtIntf;
654
655		{Likely to be made published by descendant classes}
656	+	property CaseSensitiveParameterNames: boolean read FCaseSensitiveParameterNames
657	+	write SetCaseSensitiveParameterNames;
658		property BufferChunks: Integer read FBufferChunks write SetBufferChunks;
659		property CachedUpdates: Boolean read FCachedUpdates write SetCachedUpdates;
660		property UniDirectional: Boolean read FUniDirectional write SetUniDirectional default False;
#	Line 707 | Line 719 | type
719		function IsSequenced: Boolean; override;
720		procedure Post; override;
721		function ParamByName(ParamName: String): ISQLParam;
722	+	function FindParam(ParamName: String): ISQLParam;
723		property ArrayFieldCount: integer read FArrayFieldCount;
724		property DatabaseInfo: TIBDatabaseInfo read FDatabaseInfo;
725		property UpdateObject: TIBDataSetUpdateObject read FUpdateObject write SetUpdateObject;
#	Line 764 | Line 777 | type
777		write FOnDeleteReturning;
778		end;
779
780	+	{ TIBParserDataSet }
781	+
782		TIBParserDataSet = class(TIBCustomDataSet)
783	+	protected
784	+	procedure SetFilterText(const Value: string); override;
785	+	procedure DoBeforeOpen; override;
786		public
787		property Parser;
788		end;
#	Line 801 | Line 819 | type
819		property AutoCommit;
820		property BufferChunks;
821		property CachedUpdates;
822	+	property CaseSensitiveParameterNames;
823		property EnableStatistics;
824		property DeleteSQL;
825		property InsertSQL;
#	Line 897 | Line 916 | type
916		end;
917
918		const
919	<	DefaultFieldClasses: array[TFieldType] of TFieldClass = (
919	>	DefaultFieldClasses: array[TFieldType] of TFieldClass = (
920		nil,                { ftUnknown }
921		TIBStringField,     { ftString }
922		TIBSmallintField,   { ftSmallint }
#	Line 954 | Line 973 | DefaultFieldClasses: array[TFieldType] o
973
974		implementation
975
976	<	uses Variants, FmtBCD, LazUTF8, FBMessages, IBQuery;
958	<
959	<	const FILE_BEGIN = 0;
960	<	FILE_CURRENT = 1;
961	<	FILE_END = 2;
976	>	uses Variants, FmtBCD, LazUTF8, IBMessages, IBQuery;
977
978		type
979
#	Line 1020 | Line 1035 | type
1035		Result := str;
1036		end;
1037
1038	+	{ TIBParserDataSet }
1039	+
1040	+	procedure TIBParserDataSet.SetFilterText(const Value: string);
1041	+	begin
1042	+	if Filter = Value then Exit;
1043	+	inherited SetFilterText(Value);
1044	+	if Active and Filtered then {reopen dataset}
1045	+	begin
1046	+	Active := false;
1047	+	Active := true;
1048	+	end;
1049	+	end;
1050	+
1051	+	procedure TIBParserDataSet.DoBeforeOpen;
1052	+	var i: integer;
1053	+	begin
1054	+	if assigned(FParser) then
1055	+	FParser.RestoreClauseValues;
1056	+	if Filtered and (Filter <> '') then
1057	+	Parser.Add2WhereClause(Filter);
1058	+	for i := 0 to FIBLinks.Count - 1 do
1059	+	TIBControlLink(FIBLinks[i]).UpdateSQL(self);
1060	+	inherited DoBeforeOpen;
1061	+	for i := 0 to FIBLinks.Count - 1 do
1062	+	TIBControlLink(FIBLinks[i]).UpdateParams(self);
1063	+	end;
1064	+
1065		{ TIBLargeIntField }
1066
1067		procedure TIBLargeIntField.Bind(Binding: Boolean);
#	Line 1158 | Line 1200 | begin
1200		3, {Assume UNICODE_FSS is really UTF8}
1201		4: {Include GB18030 - assuming UTF8 routines work for this codeset}
1202		if DisplayWidth = 0 then
1203	+	{$if declared(Utf8EscapeControlChars)}
1204	+	Result := Utf8EscapeControlChars(TextToSingleLine(Result))
1205	+	{$else}
1206		Result := ValidUTF8String(TextToSingleLine(Result))
1207	+	{$endif}
1208		else
1209		if UTF8Length(Result) > DisplayWidth then {Show truncation with elipses}
1210	+	{$if declared(Utf8EscapeControlChars)}
1211	+	Result := Utf8EscapeControlChars(TextToSingleLine(UTF8Copy(Result,1,DisplayWidth-3))) + '...';
1212	+	{$else}
1213		Result := ValidUTF8String(TextToSingleLine(UTF8Copy(Result,1,DisplayWidth-3))) + '...';
1214	+	{$endif}
1215		end;
1216		end
1217		end;
#	Line 1411 | Line 1461 | constructor TIBDataLink.Create(ADataSet:
1461		begin
1462		inherited Create;
1463		FDataSet := ADataSet;
1464	<	FTimer := TFPTimer.Create(nil);
1465	<	FTimer.Enabled := false;
1466	<	FTimer.Interval := 0;
1467	<	FTimer.OnTimer := HandleRefreshTimer;
1464	>	if assigned(IBGUIInterface) then
1465	>	begin
1466	>	FTimer := IBGUIInterface.CreateTimer;
1467	>	if FTimer <> nil then
1468	>	begin
1469	>	FTimer.Enabled := false;
1470	>	FTimer.Interval := 0;
1471	>	FTimer.OnTimer := HandleRefreshTimer;
1472	>	end;
1473	>	end;
1474		FDelayTimerValue := 0;
1475		end;
1476
1477		destructor TIBDataLink.Destroy;
1478		begin
1479		FDataSet.FDataLink := nil;
1424	–	if assigned(FTimer) then FTimer.Free;
1480		inherited Destroy;
1481		end;
1482
#	Line 1435 | Line 1490 | end;
1490		procedure TIBDataLink.SetDelayTimerValue(AValue: integer);
1491		begin
1492		if FDelayTimerValue = AValue then Exit;
1493	+	if assigned(FTimer) then
1494	+	FTimer.Enabled := false;
1495		FDelayTimerValue := AValue;
1439	–	{$IF FPC_FULLVERSION >= 30002}
1440	–	FTimer.Interval := FDelayTimerValue;
1441	–	{$IFEND}
1496		end;
1497
1498		procedure TIBDataLink.ActiveChanged;
#	Line 1457 | Line 1511 | procedure TIBDataLink.RecordChanged(Fiel
1511		begin
1512		if (Field = nil) and FDataSet.Active then
1513		begin
1514	<	{$IF FPC_FULLVERSION >= 30002}
1461	<	if FDelayTimerValue > 0 then
1514	>	if assigned(FTimer) and (FDelayTimerValue > 0) then
1515		with FTimer do
1516		begin
1517	<	if Enabled then
1518	<	begin
1519	<	StopTimer;
1467	<	StartTimer;
1468	<	end
1469	<	else
1470	<	Enabled := true;
1517	>	FTimer.Enabled := false;
1518	>	FTimer.Interval := FDelayTimerValue;
1519	>	FTimer.Enabled := true;
1520		end
1521		else
1473	–	{$IFEND}
1522		FDataSet.RefreshParams;
1523		end;
1524		end;
#	Line 2696 | Line 2744 | begin
2744		ActivateTransaction;
2745		FBase.CheckDatabase;
2746		FBase.CheckTransaction;
2747	<	if HasParser and (FParser.SQLText <> FQSelect.SQL.Text) then
2747	>	if HasParser and not FParser.NotaSelectStmt and (FParser.SQLText <> FQSelect.SQL.Text) then
2748		begin
2749		FQSelect.OnSQLChanged := nil; {Do not react to change}
2750		try
#	Line 2977 | Line 3025 | procedure TIBCustomDataSet.SetUniDirecti
3025		begin
3026		CheckDatasetClosed;
3027		FUniDirectional := Value;
3028	+	inherited SetUniDirectional(Value);
3029		end;
3030
3031		procedure TIBCustomDataSet.SetUpdateRecordTypes(Value: TIBUpdateRecordTypes);
#	Line 3086 | Line 3135 | end;
3135
3136		function TIBCustomDataSet.ParamByName(ParamName: String): ISQLParam;
3137		begin
3138	+	Result := FindParam(ParamName);
3139	+	if Result = nil then
3140	+	IBError(ibxeParameterNameNotFound,[ParamName]);
3141	+	end;
3142	+
3143	+	function TIBCustomDataSet.FindParam(ParamName: String): ISQLParam;
3144	+	begin
3145		ActivateConnection;
3146		ActivateTransaction;
3147		if not FInternalPrepared then
#	Line 3439 | Line 3495 | begin
3495		ApplyUpdates;
3496		end;
3497
3442	–	procedure TIBCustomDataSet.DoBeforeOpen;
3443	–	var i: integer;
3444	–	begin
3445	–	if assigned(FParser) then
3446	–	FParser.Reset;
3447	–	for i := 0 to FIBLinks.Count - 1 do
3448	–	TIBControlLink(FIBLinks[i]).UpdateSQL(self);
3449	–	inherited DoBeforeOpen;
3450	–	for i := 0 to FIBLinks.Count - 1 do
3451	–	TIBControlLink(FIBLinks[i]).UpdateParams(self);
3452	–	end;
3453	–
3498		procedure TIBCustomDataSet.DoBeforePost;
3499		begin
3500		inherited DoBeforePost;
#	Line 4739 | Line 4783 | begin
4783		Result := FQSelect.Statement;
4784		end;
4785
4786	+	procedure TIBCustomDataSet.SetCaseSensitiveParameterNames(AValue: boolean);
4787	+	begin
4788	+	if FCaseSensitiveParameterNames = AValue then Exit;
4789	+	FCaseSensitiveParameterNames := AValue;
4790	+	if assigned(FQSelect) then
4791	+	FQSelect.CaseSensitiveParameterNames := AValue;
4792	+	end;
4793	+
4794		procedure TIBCustomDataSet.SetMasterDetailDelay(AValue: integer);
4795		begin
4796		FDataLink.DelayTimerValue := AValue;
#	Line 5095 | Line 5147 | end;
5147		function TIBDataSetUpdateObject.GetRowsAffected(
5148		var SelectCount, InsertCount, UpdateCount, DeleteCount: integer): boolean;
5149		begin
5150	+	Result := true;
5151		SelectCount := 0;
5152		InsertCount := 0;
5153		UpdateCount := 0;
#	Line 5204 | Line 5257 | end;
5257
5258		procedure TIBGenerator.SetQuerySQL;
5259		begin
5260	<	FQuery.SQL.Text := Format('Select Gen_ID(%s,%d) From RDB$Database',[FGeneratorName,Increment]);
5260	>	if Database <> nil then
5261	>	FQuery.SQL.Text := Format('Select Gen_ID(%s,%d) From RDB$Database',
5262	>	[QuoteIdentifierIfNeeded(Database.SQLDialect,FGeneratorName),Increment]);
5263		end;
5264
5265		function TIBGenerator.GetDatabase: TIBDatabase;
#	Line 5220 | Line 5275 | end;
5275		procedure TIBGenerator.SetDatabase(AValue: TIBDatabase);
5276		begin
5277		FQuery.Database := AValue;
5278	+	SetQuerySQL;
5279		end;
5280
5281		procedure TIBGenerator.SetGeneratorName(AValue: string);

Diff Legend

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