ViewVC Help

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

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

Comparing ibx/trunk/runtime/nongui/IBDatabase.pas (file contents):
Revision 291 by tony, Fri Apr 17 10:26:08 2020 UTC vs.
Revision 315 by tony, Thu Feb 25 11:56:36 2021 UTC

#	Line 45 | Line 45 | uses
45		{$ELSE}
46		unix,
47		{$ENDIF}
48	<	SysUtils, Classes, FPTimer, IBExternals, DB, IB, CustApp, IBTypes;
49	<
50	<	const
51	<	DPBPrefix = 'isc_dpb_';
52	<	DPBConstantNames: array[1..isc_dpb_last_dpb_constant] of string = (
53	<	'cdd_pathname',
54	<	'allocation',
55	<	'journal',
56	<	'page_size',
57	<	'num_buffers',
58	<	'buffer_length',
59	<	'debug',
60	<	'garbage_collect',
61	<	'verify',
62	<	'sweep',
63	<	'enable_journal',
64	<	'disable_journal',
65	<	'dbkey_scope',
66	<	'number_of_users',
67	<	'trace',
68	<	'no_garbage_collect',
69	<	'damaged',
70	<	'license',
71	<	'sys_user_name',
72	<	'encrypt_key',
73	<	'activate_shadow',
74	<	'sweep_interval',
75	<	'delete_shadow',
76	<	'force_write',
77	<	'begin_log',
78	<	'quit_log',
79	<	'no_reserve',
80	<	'user_name',
81	<	'password',
82	<	'password_enc',
83	<	'sys_user_name_enc',
84	<	'interp',
85	<	'online_dump',
86	<	'old_file_size',
87	<	'old_num_files',
88	<	'old_file',
89	<	'old_start_page',
90	<	'old_start_seqno',
91	<	'old_start_file',
92	<	'drop_walfile',
93	<	'old_dump_id',
94	<	'wal_backup_dir',
95	<	'wal_chkptlen',
96	<	'wal_numbufs',
97	<	'wal_bufsize',
98	<	'wal_grp_cmt_wait',
99	<	'lc_messages',
100	<	'lc_ctype',
101	<	'cache_manager',
102	<	'shutdown',
103	<	'online',
104	<	'shutdown_delay',
105	<	'reserved',
106	<	'overwrite',
107	<	'sec_attach',
108	<	'disable_wal',
109	<	'connect_timeout',
110	<	'dummy_packet_interval',
111	<	'gbak_attach',
112	<	'sql_role_name',
113	<	'set_page_buffers',
114	<	'working_directory',
115	<	'sql_dialect',
116	<	'set_db_readonly',
117	<	'set_db_sql_dialect',
118	<	'gfix_attach',
119	<	'gstat_attach',
120	<	'set_db_charset',
121	<	'gsec_attach',
122	<	'address_path' ,
123	<	'process_id',
124	<	'no_db_triggers',
125	<	'trusted_auth',
126	<	'process_name',
127	<	'trusted_role',
128	<	'org_filename',
129	<	'utf8_ilename',
130	<	'ext_call_depth',
131	<	'auth_block',
132	<	'client_version',
133	<	'remote_protocol',
134	<	'host_name',
135	<	'os_user',
136	<	'specific_auth_data',
137	<	'auth_plugin_list',
138	<	'auth_plugin_name',
139	<	'config',
140	<	'nolinger',
141	<	'reset_icu',
142	<	'map_attach'
143	<	);
144	<
145	<	TPBPrefix = 'isc_tpb_';
146	<	TPBConstantNames: array[1..isc_tpb_last_tpb_constant] of string = (
147	<	'consistency',
148	<	'concurrency',
149	<	'shared',
150	<	'protected',
151	<	'exclusive',
152	<	'wait',
153	<	'nowait',
154	<	'read',
155	<	'write',
156	<	'lock_read',
157	<	'lock_write',
158	<	'verb_time',
159	<	'commit_time',
160	<	'ignore_limbo',
161	<	'read_committed',
162	<	'autocommit',
163	<	'rec_version',
164	<	'no_rec_version',
165	<	'restart_requests',
166	<	'no_auto_undo',
167	<	'lock_timeout'
168	<	);
48	>	SysUtils, Classes, FPTimer, IBExternals, DB, IB, CustApp, IBInternals;
49
50		type
171	–
51		TIBDatabase = class;
52		TIBTransaction = class;
53		TIBBase = class;
#	Line 179 | Line 58 | type
58
59		TIBFileName = type string;
60		{ TIBDatabase }
61	<	TIBDataBase = class(TCustomConnection)
61	>	TIBDataBase = class(TIBXMonitoredConnection)
62		private
63		type TIBDatabaseCloseActions = (caNormal,caForce, caDropDatabase);
64		private
#	Line 194 | Line 73 | type
73		FOnCreateDatabase: TNotifyEvent;
74		FOnLogin: TIBDatabaseLoginEvent;
75		FSQLHourGlass: Boolean;
197	–	FTraceFlags: TTraceFlags;
76		FSQLDialect: Integer;
77		FOnDialectDowngradeWarning: TNotifyEvent;
78		FSQLObjects: TList;
#	Line 217 | Line 95 | type
95		function GetDefaultCharSetID: integer;
96		function GetDefaultCharSetName: AnsiString;
97		function GetDefaultCodePage: TSystemCodePage;
98	+	function GetDPBConstantNames(index: byte): string;
99		function GetFirebirdAPI: IFirebirdAPI;
100		function GetRemoteProtocol: string;
101		function GetSQLObjectsCount: Integer;
#	Line 237 | Line 116 | type
116		function GetTransactionCount: Integer;
117		function Login(var aDatabaseName: string): Boolean;
118		procedure SetDatabaseName(const Value: TIBFileName);
119	<	procedure SetDBParamByDPB(const Idx: Integer; Value: String);
119	>	procedure SetDBParamByDPB(const Idx: byte; Value: String);
120		procedure SetDBParams(Value: TStrings);
121		procedure SetDefaultTransaction(Value: TIBTransaction);
122		procedure SetIdleTimer(Value: Integer);
#	Line 290 | Line 169 | type
169
170		property Attachment: IAttachment read FAttachment write SetAttachment;
171		property FirebirdAPI: IFirebirdAPI read GetFirebirdAPI;
172	+	property DPBConstantNames[index: byte]: string read GetDPBConstantNames;
173		property DBSQLDialect : Integer read GetDBSQLDialect;
174		property IsReadOnly: Boolean read GetIsReadOnly;
175		property SQLObjectCount: Integer read GetSQLObjectCount; {ignores nil objects}
#	Line 320 | Line 200 | type
200		property IdleTimer: Integer read GetIdleTimer write SetIdleTimer;
201		property SQLDialect : Integer read FSQLDialect write SetSQLDialect default 3;
202		property SQLHourGlass: Boolean read FSQLHourGlass write FSQLHourGlass default true;
203	<	property TraceFlags: TTraceFlags read FTraceFlags write FTraceFlags;
203	>	property TraceFlags;
204		property UseDefaultSystemCodePage: boolean read FUseDefaultSystemCodePage
205		write FUseDefaultSystemCodePage;
206		property WireCompression: boolean read GetWireCompression write SetWireCompression
#	Line 380 | Line 260 | type
260		function GetInTransaction: Boolean;
261		function GetIdleTimer: Integer;
262		procedure BeforeDatabaseDisconnect(DB: TIBDatabase);
263	+	function GetTPBConstantNames(index: byte): string;
264		procedure SetActive(Value: Boolean);
265		procedure SetDefaultDatabase(Value: TIBDatabase);
266		procedure SetIdleTimer(Value: Integer);
#	Line 422 | Line 303 | type
303		property InTransaction: Boolean read GetInTransaction;
304		property TransactionIntf: ITransaction read FTransactionIntf;
305		property TPB: ITPB read FTPB;
306	+	property TPBConstantNames[index: byte]: string read GetTPBConstantNames;
307		published
308		property Active: Boolean read GetInTransaction write SetActive;
309		property DefaultDatabase: TIBDatabase read FDefaultDatabase
#	Line 550 | Line 432 | begin
432		FTimer.Interval := 0;
433		FTimer.OnTimer := TimeoutConnection;
434		FSQLDialect := 3;
553	–	FTraceFlags := [];
435		FDataSets := TList.Create;
436		CheckStreamConnect;
437		FCloseAction := caNormal;
#	Line 568 | Line 449 | begin
449		SQLObjects[i].DoDatabaseFree;
450		RemoveSQLObjects;
451		RemoveTransactions;
452	+	FTimer.Free;
453		FInternalTransaction.Free;
454		FConfigOverrides.Free;
455		FDBParams.Free;
#	Line 1278 | Line 1160 | begin
1160		end;
1161		end;
1162
1163	<	procedure TIBDataBase.SetDBParamByDPB( const Idx: Integer; Value: String);
1163	>	procedure TIBDataBase.SetDBParamByDPB( const Idx: byte; Value: String);
1164		var
1165		ConstIdx: Integer;
1166		begin
#	Line 1444 | Line 1326 | begin
1326		Result := CP_NONE;
1327		end;
1328
1329	+	function TIBDataBase.GetDPBConstantNames(index: byte): string;
1330	+	begin
1331	+	Result := FirebirdAPI.AllocateDPB.GetDPBParamTypeName(index);
1332	+	if Result = '' then
1333	+	IBError(ibxeDPBConstantUnknown,[index]);
1334	+	end;
1335	+
1336		function TIBDataBase.GetFirebirdAPI: IFirebirdAPI;
1337		var fblib: IFirebirdLibrary;
1338		begin
#	Line 2026 | Line 1915 | begin
1915		FTransactionIntf := nil;
1916		end;
1917
1918	+	function TIBTransaction.GetTPBConstantNames(index: byte): string;
1919	+	begin
1920	+	CheckDatabasesInList;
1921	+	if FTPB = nil then
1922	+	FTPB := Databases[0].FirebirdAPI.AllocateTPB;
1923	+	Result := FTPB.GetDPBParamTypeName(index);
1924	+	if Result = '' then
1925	+	IBError(ibxeTPBConstantUnknown,[index]);
1926	+	end;
1927	+
1928		procedure TIBTransaction.RemoveDatabase(Idx: Integer);
1929		var
1930		DB: TIBDatabase;
#	Line 2184 | Line 2083 | begin
2083		else
2084		IBError(ibxeDatabaseClosed, [nil]);
2085		end;
2086	<	if FTRParamsChanged then
2086	>	if FTRParamsChanged or (FTPB = nil) then
2087		begin
2088		FTRParamsChanged := False;
2089		FTPB :=  GenerateTPB(Databases[0].FirebirdAPI,FTRParams);
#	Line 2410 | Line 2309 | end;
2309
2310		function TIBDataBase.GenerateDPB(FirebirdAPI: IFirebirdAPI; sl: TStrings): IDPB;
2311		var
2312	<	i, j: Integer;
2313	<	DPBVal: UShort;
2314	<	ParamName, ParamValue: string;
2312	>	i: Integer;
2313	>	ParamValue: string;
2314	>	DPBItem: IDPBItem;
2315		begin
2316		Result := FirebirdAPI.AllocateDPB;
2317
#	Line 2426 | Line 2325 | begin
2325		}
2326		if (Trim(sl.Names[i]) = '') then
2327		continue;
2328	<	ParamName := LowerCase(sl.Names[i]); {mbcs ok}
2329	<	ParamValue := Copy(sl[i], Pos('=', sl[i]) + 1, Length(sl[i])); {mbcs ok}
2330	<	if (Pos(DPBPrefix, ParamName) = 1) then {mbcs ok}
2432	<	Delete(ParamName, 1, Length(DPBPrefix));
2433	<	{ We want to translate the parameter name to some Integer
2434	<	value. We do this by scanning through a list of known
2435	<	database parameter names (DPBConstantNames, defined above) }
2436	<	DPBVal := 0;
2437	<	{ Find the parameter }
2438	<	for j := 1 to isc_dpb_last_dpb_constant do
2439	<	if (ParamName = DPBConstantNames[j]) then
2440	<	begin
2441	<	DPBVal := j;
2442	<	break;
2443	<	end;
2328	>
2329	>	DPBItem := Result.AddByTypeName(sl.Names[i]); {mbcs ok}
2330	>	ParamValue := sl.ValueFromIndex[i]; {mbcs ok}
2331		{  A database parameter either contains a string value (case 1)
2332		or an Integer value (case 2)
2333		or no value at all (case 3)
2334		or an error needs to be generated (case else)  }
2335	<	case DPBVal of
2335	>	case DPBItem.getParamType of
2336		isc_dpb_user_name, isc_dpb_password, isc_dpb_password_enc,
2337		isc_dpb_sys_user_name, isc_dpb_license, isc_dpb_encrypt_key,
2338		isc_dpb_lc_messages, isc_dpb_lc_ctype, isc_dpb_page_size,
2339	<	isc_dpb_sql_role_name, isc_dpb_sql_dialect:
2339	>	isc_dpb_sql_role_name:
2340	>	DPBItem.SetAsString(ParamValue);
2341	>
2342	>	isc_dpb_sql_dialect:
2343		begin
2344	<	if DPBVal = isc_dpb_sql_dialect then
2345	<	ParamValue[1] := Char(Ord(ParamValue[1]) - 48);
2346	<	Result.Add(DPBVal).SetAsString(ParamValue);
2344	>	if (ParamValue = '') or (ParamValue[1] = '3') then
2345	>	DPBItem.SetAsString(#03)
2346	>	else
2347	>	DPBItem.SetAsString(#01)
2348		end;
2349
2350	+
2351		isc_dpb_num_buffers, isc_dpb_dbkey_scope, isc_dpb_force_write,
2352		isc_dpb_no_reserve, isc_dpb_damaged, isc_dpb_verify:
2353	<	Result.Add(DPBVal).SetAsByte(byte(ParamValue[1]));
2353	>	DPBItem.SetAsByte(byte(ParamValue[1]));
2354
2355		isc_dpb_sweep:
2356	<	Result.Add(DPBVal).SetAsByte(isc_dpb_records);
2356	>	DPBItem.SetAsByte(isc_dpb_records);
2357
2358		isc_dpb_sweep_interval:
2359	<	Result.Add(DPBVal).SetAsInteger(StrToInt(ParamValue));
2359	>	DPBItem.SetAsInteger(StrToInt(ParamValue));
2360
2361		isc_dpb_activate_shadow, isc_dpb_delete_shadow, isc_dpb_begin_log,
2362		isc_dpb_map_attach, isc_dpb_quit_log:
2363	<	Result.Add(DPBVal).SetAsByte(0);
2363	>	DPBItem.SetAsByte(0);
2364		else
2365	<	begin
2474	<	if (DPBVal > 0) and
2475	<	(DPBVal <= isc_dpb_last_dpb_constant) then
2476	<	IBError(ibxeDPBConstantNotSupported, [DPBConstantNames[DPBVal]])
2477	<	else
2478	<	IBError(ibxeDPBConstantUnknownEx, [sl.Names[i]]);
2479	<	end;
2365	>	IBError(ibxeDPBConstantNotSupported, [DPBItem.getParamTypeName])
2366		end;
2367		end;
2368		if FConfigOverrides.Count > 0 then
#	Line 2490 | Line 2376 | end;
2376		TPB and TPBLength, respectively. }
2377		function TIBTransaction.GenerateTPB(FirebirdAPI: IFirebirdAPI; sl: TStrings): ITPB;
2378		var
2379	<	i, j, TPBVal: Integer;
2379	>	i: Integer;
2380		ParamName, ParamValue: string;
2381	+	TPBItem: ITPBItem;
2382		begin
2383		Result := FirebirdAPI.AllocateTPB;
2384		for i := 0 to sl.Count - 1 do
#	Line 2499 | Line 2386 | begin
2386		if (Trim(sl[i]) =  '') then
2387		Continue;
2388
2389	<	if (Pos('=', sl[i]) = 0) then {mbcs ok}
2390	<	ParamName := LowerCase(sl[i]) {mbcs ok}
2391	<	else
2392	<	begin
2393	<	ParamName := LowerCase(sl.Names[i]); {mbcs ok}
2394	<	ParamValue := Copy(sl[i], Pos('=', sl[i]) + 1, Length(sl[i])); {mbcs ok}
2508	<	end;
2509	<	if (Pos(TPBPrefix, ParamName) = 1) then {mbcs ok}
2510	<	Delete(ParamName, 1, Length(TPBPrefix));
2511	<	TPBVal := 0;
2512	<	{ Find the parameter }
2513	<	for j := 1 to isc_tpb_last_tpb_constant do
2514	<	if (ParamName = TPBConstantNames[j]) then
2515	<	begin
2516	<	TPBVal := j;
2517	<	break;
2518	<	end;
2519	<	{ Now act on it }
2520	<	case TPBVal of
2389	>	ParamName := sl.Names[i];
2390	>	if ParamName = '' then ParamName := sl[i];
2391	>	TPBItem := Result.AddByTypeName(ParamName);
2392	>	ParamValue := sl.ValueFromIndex[i];
2393	>
2394	>	case TPBItem.getParamType of
2395		isc_tpb_consistency, isc_tpb_exclusive, isc_tpb_protected,
2396		isc_tpb_concurrency, isc_tpb_shared, isc_tpb_wait, isc_tpb_nowait,
2397		isc_tpb_read, isc_tpb_write, isc_tpb_ignore_limbo,
2398		isc_tpb_read_committed, isc_tpb_rec_version, isc_tpb_no_rec_version:
2399	<	Result.Add(TPBVal);
2399	>	{nothing more to do};
2400
2401		isc_tpb_lock_read, isc_tpb_lock_write:
2402	<	Result.Add(TPBVal).SetAsString(ParamValue);
2402	>	TPBItem.SetAsString(ParamValue);
2403
2404		else
2405	<	begin
2532	<	if (TPBVal > 0) and
2533	<	(TPBVal <= isc_tpb_last_tpb_constant) then
2534	<	IBError(ibxeTPBConstantNotSupported, [TPBConstantNames[TPBVal]])
2535	<	else
2536	<	IBError(ibxeTPBConstantUnknownEx, [sl.Names[i]]);
2537	<	end;
2405	>	IBError(ibxeTPBConstantNotSupported, [TPBItem.getParamTypeName])
2406		end;
2407		end;
2408		end;

Diff Legend

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