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 221 by tony, Mon Mar 19 09:48:37 2018 UTC vs.
Revision 270 by tony, Fri Jan 18 11:10:37 2019 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 643 | Line 654 | type
654		property SelectStmtHandle: IStatement read GetSelectStmtIntf;
655
656		{Likely to be made published by descendant classes}
657	+	property CaseSensitiveParameterNames: boolean read FCaseSensitiveParameterNames
658	+	write SetCaseSensitiveParameterNames;
659		property BufferChunks: Integer read FBufferChunks write SetBufferChunks;
660		property CachedUpdates: Boolean read FCachedUpdates write SetCachedUpdates;
661		property UniDirectional: Boolean read FUniDirectional write SetUniDirectional default False;
#	Line 801 | Line 814 | type
814		property AutoCommit;
815		property BufferChunks;
816		property CachedUpdates;
817	+	property CaseSensitiveParameterNames;
818		property EnableStatistics;
819		property DeleteSQL;
820		property InsertSQL;
#	Line 897 | Line 911 | type
911		end;
912
913		const
914	<	DefaultFieldClasses: array[TFieldType] of TFieldClass = (
914	>	DefaultFieldClasses: array[TFieldType] of TFieldClass = (
915		nil,                { ftUnknown }
916		TIBStringField,     { ftString }
917		TIBSmallintField,   { ftSmallint }
#	Line 956 | Line 970 | implementation
970
971		uses Variants, FmtBCD, LazUTF8, FBMessages, IBQuery;
972
959	–	const FILE_BEGIN = 0;
960	–	FILE_CURRENT = 1;
961	–	FILE_END = 2;
962	–
973		type
974
975		TFieldNode = class(TObject)
#	Line 1158 | Line 1168 | begin
1168		3, {Assume UNICODE_FSS is really UTF8}
1169		4: {Include GB18030 - assuming UTF8 routines work for this codeset}
1170		if DisplayWidth = 0 then
1171	+	{$if declared(Utf8EscapeControlChars)}
1172	+	Result := Utf8EscapeControlChars(TextToSingleLine(Result))
1173	+	{$else}
1174		Result := ValidUTF8String(TextToSingleLine(Result))
1175	+	{$endif}
1176		else
1177		if UTF8Length(Result) > DisplayWidth then {Show truncation with elipses}
1178	+	{$if declared(Utf8EscapeControlChars)}
1179	+	Result := Utf8EscapeControlChars(TextToSingleLine(UTF8Copy(Result,1,DisplayWidth-3))) + '...';
1180	+	{$else}
1181		Result := ValidUTF8String(TextToSingleLine(UTF8Copy(Result,1,DisplayWidth-3))) + '...';
1182	+	{$endif}
1183		end;
1184		end
1185		end;
#	Line 1411 | Line 1429 | constructor TIBDataLink.Create(ADataSet:
1429		begin
1430		inherited Create;
1431		FDataSet := ADataSet;
1432	<	FTimer := TFPTimer.Create(nil);
1433	<	FTimer.Enabled := false;
1434	<	FTimer.Interval := 0;
1435	<	FTimer.OnTimer := HandleRefreshTimer;
1432	>	if assigned(IBGUIInterface) then
1433	>	begin
1434	>	FTimer := IBGUIInterface.CreateTimer;
1435	>	if FTimer <> nil then
1436	>	begin
1437	>	FTimer.Enabled := false;
1438	>	FTimer.Interval := 0;
1439	>	FTimer.OnTimer := HandleRefreshTimer;
1440	>	end;
1441	>	end;
1442		FDelayTimerValue := 0;
1443		end;
1444
1445		destructor TIBDataLink.Destroy;
1446		begin
1447		FDataSet.FDataLink := nil;
1424	–	if assigned(FTimer) then FTimer.Free;
1448		inherited Destroy;
1449		end;
1450
#	Line 1435 | Line 1458 | end;
1458		procedure TIBDataLink.SetDelayTimerValue(AValue: integer);
1459		begin
1460		if FDelayTimerValue = AValue then Exit;
1461	+	if assigned(FTimer) then
1462	+	FTimer.Enabled := false;
1463		FDelayTimerValue := AValue;
1439	–	{$IF FPC_FULLVERSION >= 30002}
1440	–	if (AValue > 0) and not IsMultiThread then
1441	–	IBError(ibxeMultiThreadRequired,['TIBQuery/TIBDataset MasterDetailDelay']);
1442	–	FTimer.Interval := FDelayTimerValue;
1443	–	{$IFEND}
1464		end;
1465
1466		procedure TIBDataLink.ActiveChanged;
#	Line 1459 | Line 1479 | procedure TIBDataLink.RecordChanged(Fiel
1479		begin
1480		if (Field = nil) and FDataSet.Active then
1481		begin
1482	<	{$IF FPC_FULLVERSION >= 30002}
1463	<	if FDelayTimerValue > 0 then
1482	>	if assigned(FTimer) and (FDelayTimerValue > 0) then
1483		with FTimer do
1484		begin
1485	<	CheckSynchronize; {Ensure not waiting on Synchronize}
1486	<	if Enabled then
1487	<	begin
1469	<	StopTimer;
1470	<	StartTimer;
1471	<	end
1472	<	else
1473	<	Enabled := true;
1485	>	FTimer.Enabled := false;
1486	>	FTimer.Interval := FDelayTimerValue;
1487	>	FTimer.Enabled := true;
1488		end
1489		else
1476	–	{$IFEND}
1490		FDataSet.RefreshParams;
1491		end;
1492		end;
#	Line 2699 | Line 2712 | begin
2712		ActivateTransaction;
2713		FBase.CheckDatabase;
2714		FBase.CheckTransaction;
2715	<	if HasParser and (FParser.SQLText <> FQSelect.SQL.Text) then
2715	>	if HasParser and not FParser.NotaSelectStmt and (FParser.SQLText <> FQSelect.SQL.Text) then
2716		begin
2717		FQSelect.OnSQLChanged := nil; {Do not react to change}
2718		try
#	Line 3094 | Line 3107 | begin
3107		if not FInternalPrepared then
3108		InternalPrepare;
3109		Result := Params.ByName(ParamName);
3110	+	if Result = nil then
3111	+	IBError(ibxeParameterNameNotFound,[ParamName]);
3112		end;
3113
3114		function TIBCustomDataSet.GetRowsAffected(var SelectCount, InsertCount,
#	Line 3446 | Line 3461 | procedure TIBCustomDataSet.DoBeforeOpen;
3461		var i: integer;
3462		begin
3463		if assigned(FParser) then
3464	<	FParser.Reset;
3464	>	FParser.RestoreClauseValues;
3465		for i := 0 to FIBLinks.Count - 1 do
3466		TIBControlLink(FIBLinks[i]).UpdateSQL(self);
3467		inherited DoBeforeOpen;
#	Line 4742 | Line 4757 | begin
4757		Result := FQSelect.Statement;
4758		end;
4759
4760	+	procedure TIBCustomDataSet.SetCaseSensitiveParameterNames(AValue: boolean);
4761	+	begin
4762	+	if FCaseSensitiveParameterNames = AValue then Exit;
4763	+	FCaseSensitiveParameterNames := AValue;
4764	+	if assigned(FQSelect) then
4765	+	FQSelect.CaseSensitiveParameterNames := AValue;
4766	+	end;
4767	+
4768		procedure TIBCustomDataSet.SetMasterDetailDelay(AValue: integer);
4769		begin
4770		FDataLink.DelayTimerValue := AValue;

Diff Legend

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