ViewVC Help

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

root/public/ibx/branches/journaling/runtime/nongui/IBCustomDataSet.pas

Comparing ibx/trunk/runtime/nongui/IBCustomDataSet.pas (file contents):
Revision 209 by tony, Wed Mar 14 12:48:51 2018 UTC vs.
Revision 270 by tony, Fri Jan 18 11:10:37 2019 UTC

#	Line 49 | Line 49 | interface
49		uses
50		{$IFDEF WINDOWS }
51		Windows,
52	<	{$ELSE}
52	>	{$ENDIF}
53	>	{$IFDEF UNIX}
54		unix,
55		{$ENDIF}
56		SysUtils, Classes, IBDatabase, IBExternals, IB,  IBSQL, Db,
57	<	IBUtils, IBBlob, IBSQLParser, IBDatabaseInfo, fpTimer;
57	<
58	<	const
59	<	BufferCacheSize    =  1000;  { Allocate cache in this many record chunks}
60	<	UniCache           =  2;     { Uni-directional cache is 2 records big }
57	>	IBUtils, IBBlob, IBSQLParser, IBDatabaseInfo, IBTypes;
58
59		type
60		TIBCustomDataSet = class;
#	Line 87 | Line 84 | type
84		property RefreshSQL: TStrings read FRefreshSQL write SetRefreshSQL;
85		end;
86
90	–	TBlobDataArray = array[0..0] of TIBBlobStream;
91	–	PBlobDataArray = ^TBlobDataArray;
87		TIBArrayField = class;
88
89		{ TIBArray }
#	Line 107 | Line 102 | type
102		property ArrayIntf: IArray read FArray;
103		end;
104
110	–	TArrayDataArray = array [0..0] of TIBArray;
111	–	PArrayDataArray = ^TArrayDataArray;
112	–
113	–	{ TIBCustomDataSet }
114	–
115	–	TCachedUpdateStatus = (
116	–	cusUnmodified, cusModified, cusInserted,
117	–	cusDeleted, cusUninserted
118	–	);
119	–	TIBDBKey = record
120	–	DBKey: array[0..7] of Byte;
121	–	end;
122	–	PIBDBKey = ^TIBDBKey;
123	–
124	–	PFieldData = ^TFieldData;
125	–	TFieldData = record
126	–	fdIsNull: Boolean;
127	–	fdDataLength: Short;
128	–	end;
129	–
130	–	PColumnData = ^TColumnData;
131	–	TColumnData = record
132	–	fdDataType: Short;
133	–	fdDataScale: Short;
134	–	fdNullable: Boolean;
135	–	fdDataSize: Short;
136	–	fdDataOfs: Integer;
137	–	fdCodePage: TSystemCodePage;
138	–	end;
139	–
140	–	PFieldColumns = ^TFieldColumns;
141	–	TFieldColumns =  array[1..1] of TColumnData;
142	–
143	–	TRecordData = record
144	–	rdBookmarkFlag: TBookmarkFlag;
145	–	rdFieldCount: Short;
146	–	rdRecordNumber: Integer;
147	–	rdCachedUpdateStatus: TCachedUpdateStatus;
148	–	rdUpdateStatus: TUpdateStatus;
149	–	rdSavedOffset: DWORD;
150	–	rdDBKey: TIBDBKey;
151	–	rdFields: array[1..1] of TFieldData;
152	–	end;
153	–	PRecordData = ^TRecordData;
154	–
105		{ TIBArrayField }
106
107		TIBArrayField = class(TField)
#	Line 299 | 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
256		procedure ActiveChanged; override;
257		procedure RecordChanged(Field: TField); override;
#	Line 310 | Line 261 | type
261		constructor Create(ADataSet: TIBCustomDataSet);
262		destructor Destroy; override;
263		property DelayTimerValue: integer {in Milliseconds}
264	<	read FDelayTimerValue write FDelayTimerValue;
264	>	read FDelayTimerValue write SetDelayTimerValue;
265		end;
266
267		TIBGeneratorApplyOnEvent = (gaeOnNewRecord,gaeOnPostRecord);
#	Line 364 | Line 315 | type
315
316		TIBAutoCommit = (acDisabled, acCommitRetaining);
317
367	–	{ TIBCustomDataSet }
368	–
318		TIBUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApply, uaApplied);
319
320		TIBUpdateErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
#	Line 374 | Line 323 | type
323		TIBUpdateRecordEvent = procedure(DataSet: TDataSet; UpdateKind: TUpdateKind;
324		var UpdateAction: TIBUpdateAction) of object;
325
377	–	TIBUpdateRecordTypes = set of TCachedUpdateStatus;
378	–
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 463 | 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 641 | 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 799 | 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 895 | 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 954 | Line 970 | implementation
970
971		uses Variants, FmtBCD, LazUTF8, FBMessages, IBQuery;
972
957	–	const FILE_BEGIN = 0;
958	–	FILE_CURRENT = 1;
959	–	FILE_END = 2;
960	–
973		type
974
975		TFieldNode = class(TObject)
#	Line 1156 | 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 1409 | Line 1429 | constructor TIBDataLink.Create(ADataSet:
1429		begin
1430		inherited Create;
1431		FDataSet := ADataSet;
1432	<	FTimer := TFPTimer.Create(nil);
1433	<	FTimer.Enabled := true;
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;
1422	–	if assigned(FTimer) then FTimer.Free;
1448		inherited Destroy;
1449		end;
1450
1451		procedure TIBDataLink.HandleRefreshTimer(Sender: TObject);
1452		begin
1453	<	FTimer.Interval := 0;
1454	<	FDataSet.RefreshParams;
1453	>	FTimer.Enabled := false;
1454	>	if FDataSet.Active then
1455	>	FDataSet.RefreshParams;
1456	>	end;
1457	>
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;
1464		end;
1465
1466		procedure TIBDataLink.ActiveChanged;
#	Line 1445 | Line 1479 | procedure TIBDataLink.RecordChanged(Fiel
1479		begin
1480		if (Field = nil) and FDataSet.Active then
1481		begin
1482	<	if FDelayTimerValue > 0 then
1482	>	if assigned(FTimer) and (FDelayTimerValue > 0) then
1483	>	with FTimer do
1484		begin
1485	+	FTimer.Enabled := false;
1486		FTimer.Interval := FDelayTimerValue;
1487	<	FTimer.StartTimer;
1487	>	FTimer.Enabled := true;
1488		end
1489		else
1490		FDataSet.RefreshParams;
#	Line 2676 | 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 3071 | 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 3423 | 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 4719 | 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;
#	Line 5075 | Line 5121 | end;
5121		function TIBDataSetUpdateObject.GetRowsAffected(
5122		var SelectCount, InsertCount, UpdateCount, DeleteCount: integer): boolean;
5123		begin
5124	+	Result := true;
5125		SelectCount := 0;
5126		InsertCount := 0;
5127		UpdateCount := 0;

Diff Legend

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