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 263 by tony, Thu Dec 6 15:55:01 2018 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
65		FCloseAction: TIBDatabaseCloseActions;
66		FAttachment: IAttachment;
67	+	FConfigOverrides: TStrings;
68		FCreateDatabase: boolean;
69		FCreateIfNotExists: boolean;
70		FAllowStreamedConnected: boolean;
#	Line 193 | Line 73 | type
73		FOnCreateDatabase: TNotifyEvent;
74		FOnLogin: TIBDatabaseLoginEvent;
75		FSQLHourGlass: Boolean;
196	–	FTraceFlags: TTraceFlags;
76		FSQLDialect: Integer;
77		FOnDialectDowngradeWarning: TNotifyEvent;
78		FSQLObjects: TList;
#	Line 216 | 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;
102	+	function GetWireCompression: boolean;
103	+	procedure SetAttachment(AValue: IAttachment);
104	+	procedure SetConfigOverrides(AValue: TStrings);
105		procedure SetFirebirdLibraryPathName(AValue: TIBFileName);
106		procedure SetSQLDialect(const Value: Integer);
107	+	procedure SetWireCompression(AValue: boolean);
108		procedure ValidateClientSQLDialect;
109		procedure DBParamsChange(Sender: TObject);
110		procedure DBParamsChanging(Sender: TObject);
111	+	function GenerateDPB(FirebirdAPI: IFirebirdAPI; sl: TStrings): IDPB;
112		function GetSQLObject(Index: Integer): TIBBase;
113		function GetSQLObjectCount: Integer;
114		function GetIdleTimer: Integer;
#	Line 231 | 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 241 | Line 126 | type
126		procedure RemoveSQLObject(Idx: Integer);
127		procedure RemoveSQLObjects;
128		procedure InternalClose;
129	+	procedure InternalBeforeClose;
130	+	procedure InternalAfterClose;
131	+	procedure InternalBeforeConnect(aDBParams: TStrings; var aDBName: string;
132	+	var aCreateIfNotExists: boolean);
133	+	procedure InternalAfterConnect;
134		procedure DoOnCreateDatabase;
135
136		protected
#	Line 277 | Line 167 | type
167		procedure RemoveTransaction(Idx: Integer);
168		procedure RemoveTransactions;
169
170	<	property Attachment: IAttachment read FAttachment;
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 302 | Line 193 | type
193		property FirebirdLibraryPathName: TIBFileName read FFirebirdLibraryPathName
194		write SetFirebirdLibraryPathName;
195		property Params: TStrings read FDBParams write SetDBParams;
196	+	property ConfigOverrides: TStrings read FConfigOverrides write SetConfigOverrides;
197		property LoginPrompt default True;
198		property DefaultTransaction: TIBTransaction read FDefaultTransaction
199		write SetDefaultTransaction;
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
207	+	stored false;
208		property AfterConnect;
209		property AfterDisconnect;
210		property BeforeConnect;
#	Line 366 | 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 376 | Line 271 | type
271		function AddSQLObject(ds: TIBBase): Integer;
272		procedure RemoveSQLObject(Idx: Integer);
273		procedure RemoveSQLObjects;
274	+	function GenerateTPB(FirebirdAPI: IFirebirdAPI; sl: TStrings): ITPB;
275
276		protected
277		procedure Loaded; override;
#	Line 407 | 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 503 | Line 400 | type
400		write SetTransaction;
401		end;
402
506	–	function GenerateDPB(FirebirdAPI: IFirebirdAPI; sl: TStrings): IDPB;
507	–	function GenerateTPB(FirebirdAPI: IFirebirdAPI; sl: TStrings): ITPB;
508	–
403
404		implementation
405
406		uses  IBSQLMonitor, IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils,
407	<	typInfo, FBMessages, IBErrorCodes {$IFDEF WINDOWS}, Windirs {$ENDIF};
407	>	typInfo, IBMessages, IBErrorCodes {$IFDEF WINDOWS}, Windirs {$ENDIF};
408
409		{ TIBDatabase }
410
#	Line 520 | Line 414 | begin
414		LoginPrompt := True;
415		FSQLObjects := TList.Create;
416		FTransactions := TList.Create;
417	+	FConfigOverrides := TStringList.Create;
418		FDBName := '';
419		FDBParams := TStringList.Create;
420		FSQLHourGlass := true;
#	Line 537 | Line 432 | begin
432		FTimer.Interval := 0;
433		FTimer.OnTimer := TimeoutConnection;
434		FSQLDialect := 3;
540	–	FTraceFlags := [];
435		FDataSets := TList.Create;
436		CheckStreamConnect;
437		FCloseAction := caNormal;
#	Line 555 | Line 449 | begin
449		SQLObjects[i].DoDatabaseFree;
450		RemoveSQLObjects;
451		RemoveTransactions;
452	+	FTimer.Free;
453		FInternalTransaction.Free;
454	+	FConfigOverrides.Free;
455		FDBParams.Free;
456		FSQLObjects.Free;
457		FTransactions.Free;
#	Line 802 | Line 698 | begin
698		end;
699
700		procedure TIBDataBase.InternalClose;
701	+	begin
702	+	CheckActive;
703	+	InternalBeforeClose;
704	+	case FCloseAction of
705	+	caNormal:
706	+	FAttachment.Disconnect(false);
707	+	caForce:
708	+	FAttachment.Disconnect(true);
709	+	caDropDatabase:
710	+	FAttachment.DropDatabase;
711	+	end;
712	+	FAttachment := nil;
713	+	FHiddenPassword := '';
714	+	FCloseAction := caNormal;
715	+
716	+	if not (csDesigning in ComponentState) then
717	+	MonitorHook.DBDisconnect(Self);
718	+
719	+	InternalAfterClose;
720	+	end;
721	+
722	+	procedure TIBDataBase.InternalBeforeClose;
723		var
724		i: Integer;
725		begin
808	–	CheckActive;
726		{ Tell all connected transactions that we're disconnecting.
727		This is so transactions can commit/rollback, accordingly
728		}
#	Line 830 | Line 747 | begin
747		end;
748		end;
749
750	<	case FCloseAction of
834	<	caNormal:
835	<	FAttachment.Disconnect(false);
836	<	caForce:
837	<	FAttachment.Disconnect(true);
838	<	caDropDatabase:
839	<	FAttachment.DropDatabase;
840	<	end;
841	<	FAttachment := nil;
842	<	FHiddenPassword := '';
843	<	FCloseAction := caNormal;
844	<
845	<	if not (csDesigning in ComponentState) then
846	<	MonitorHook.DBDisconnect(Self);
750	>	end;
751
752	+	procedure TIBDataBase.InternalAfterClose;
753	+	var
754	+	i: Integer;
755	+	begin
756		for i := 0 to FSQLObjects.Count - 1 do
757		if FSQLObjects[i] <> nil then
758		SQLObjects[i].DoAfterDatabaseDisconnect;
759		end;
760
761	+	procedure TIBDataBase.InternalBeforeConnect(aDBParams: TStrings; var aDBName: string;
762	+	var aCreateIfNotExists: boolean);
763	+	var i: integer;
764	+	begin
765	+	{Opportunity to override defaults}
766	+	for i := 0 to FSQLObjects.Count - 1 do
767	+	begin
768	+	if FSQLObjects[i] <> nil then
769	+	SQLObjects[i].DoBeforeDatabaseConnect(aDBParams,aDBName, aCreateIfNotExists);
770	+	end;
771	+	end;
772	+
773	+	procedure TIBDataBase.InternalAfterConnect;
774	+	var i: integer;
775	+	begin
776	+	for i := 0 to FSQLObjects.Count - 1 do
777	+	begin
778	+	if FSQLObjects[i] <> nil then
779	+	SQLObjects[i].DoAfterDatabaseConnect;
780	+	end;
781	+	end;
782	+
783		procedure TIBDataBase.DoOnCreateDatabase;
784		var i: integer;
785		begin
#	Line 1043 | Line 973 | procedure TIBDataBase.DoConnect;
973
974		var
975		TempDBParams: TStrings;
1046	–	I: integer;
976		aDBName, oldDBName: string;
977		Status: IStatus;
978		CharSetID: integer;
#	Line 1081 | Line 1010 | begin
1010		if UseDefaultSystemCodePage then
1011		TempDBParams.Values['lc_ctype'] :='UTF8';
1012		{$endif}
1013	<	{Opportunity to override defaults}
1085	<	for i := 0 to FSQLObjects.Count - 1 do
1086	<	begin
1087	<	if FSQLObjects[i] <> nil then
1088	<	SQLObjects[i].DoBeforeDatabaseConnect(TempDBParams,aDBName, aCreateIfNotExists);
1089	<	end;
1013	>	InternalBeforeConnect(TempDBParams,aDBName,aCreateIfNotExists);
1014
1015		repeat
1016		{ Generate a new DPB if necessary }
#	Line 1108 | Line 1032 | begin
1032		DPB.Add(isc_dpb_set_db_SQL_dialect).AsByte := SQLDialect; {create with this SQL Dialect}
1033		FAttachment := FirebirdAPI.CreateDatabase(aDBName,DPB, false);
1034		if FAttachment = nil then
1035	<	DPB := nil;
1036	<	DoOnCreateDatabase;
1035	>	DPB := nil
1036	>	else
1037	>	DoOnCreateDatabase;
1038		end
1039		else
1040		FAttachment := FirebirdAPI.OpenDatabase(aDBName,DPB,false);
#	Line 1172 | Line 1097 | begin
1097		if not (csDesigning in ComponentState) then
1098		FDBName := aDBName; {Synchronise at run time}
1099		ValidateClientSQLDialect;
1100	<	for i := 0 to FSQLObjects.Count - 1 do
1176	<	begin
1177	<	if FSQLObjects[i] <> nil then
1178	<	SQLObjects[i].DoAfterDatabaseConnect;
1179	<	end;
1100	>	InternalAfterConnect;
1101		if not (csDesigning in ComponentState) then
1102		MonitorHook.DBConnect(Self);
1103		end;
#	Line 1239 | 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 1362 | Line 1283 | begin
1283		IBError(ibxeSQLDialectInvalid, [nil]);
1284		end;
1285
1286	+	procedure TIBDataBase.SetWireCompression(AValue: boolean);
1287	+	var Index: integer;
1288	+	begin
1289	+	if AValue then
1290	+	FConfigOverrides.Values['WireCompression'] := 'true'
1291	+	else
1292	+	begin
1293	+	Index := FConfigOverrides.IndexOfName('WireCompression');
1294	+	if Index <> -1 then
1295	+	FConfigOverrides.Delete(Index);
1296	+	end;
1297	+	end;
1298	+
1299		function TIBDataBase.GetDBSQLDialect: Integer;
1300		begin
1301		CheckActive;
#	Line 1392 | 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 1420 | Line 1361 | begin
1361		Result := FSQLObjects.Count;
1362		end;
1363
1364	+	function TIBDataBase.GetWireCompression: boolean;
1365	+	begin
1366	+	Result := CompareText(FConfigOverrides.Values['WireCompression'],'true') = 0;
1367	+	end;
1368	+
1369	+	procedure TIBDataBase.SetAttachment(AValue: IAttachment);
1370	+	begin
1371	+	if FAttachment = AValue then Exit;
1372	+	if FAttachment <> nil then
1373	+	begin
1374	+	if Assigned(BeforeDisconnect) then
1375	+	BeforeDisconnect(self);
1376	+	InternalBeforeClose;
1377	+	FAttachment := nil;
1378	+	FFirebirdAPI := nil;
1379	+	InternalAfterClose;
1380	+	if Assigned(AfterDisconnect) then
1381	+	AfterDisconnect(self);
1382	+	end;
1383	+	if Assigned(BeforeConnect) then
1384	+	BeforeConnect(self);
1385	+	FAttachment := AValue;
1386	+	if FAttachment <> nil then
1387	+	begin
1388	+	ValidateClientSQLDialect;
1389	+	FDBName := FAttachment.GetConnectString;
1390	+	if FFirebirdLibraryPathName <> '' then
1391	+	FFirebirdLibraryPathName := FAttachment.getFirebirdAPI.GetFBLibrary.GetLibraryFilePath;
1392	+	InternalAfterConnect;
1393	+	if Assigned(AfterConnect) then
1394	+	AfterConnect(self);
1395	+	end;
1396	+	end;
1397	+
1398	+	procedure TIBDataBase.SetConfigOverrides(AValue: TStrings);
1399	+	begin
1400	+	if FConfigOverrides = AValue then Exit;
1401	+	FConfigOverrides.Assign(AValue);
1402	+	end;
1403	+
1404		procedure TIBDataBase.SetFirebirdLibraryPathName(AValue: TIBFileName);
1405		begin
1406		if FFirebirdLibraryPathName = AValue then Exit;
#	Line 1934 | 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 2092 | 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 2316 | Line 2307 | end;
2307		parameter buffer, and return it and its length
2308		in DPB and DPBLength, respectively. }
2309
2310	<	function GenerateDPB(FirebirdAPI: IFirebirdAPI; sl: TStrings): IDPB;
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 2334 | 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}
2340	<	Delete(ParamName, 1, Length(DPBPrefix));
2341	<	{ We want to translate the parameter name to some Integer
2342	<	value. We do this by scanning through a list of known
2343	<	database parameter names (DPBConstantNames, defined above) }
2344	<	DPBVal := 0;
2345	<	{ Find the parameter }
2346	<	for j := 1 to isc_dpb_last_dpb_constant do
2347	<	if (ParamName = DPBConstantNames[j]) then
2348	<	begin
2349	<	DPBVal := j;
2350	<	break;
2351	<	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
2382	<	if (DPBVal > 0) and
2383	<	(DPBVal <= isc_dpb_last_dpb_constant) then
2384	<	IBError(ibxeDPBConstantNotSupported, [DPBConstantNames[DPBVal]])
2385	<	else
2386	<	IBError(ibxeDPBConstantUnknownEx, [sl.Names[i]]);
2387	<	end;
2365	>	IBError(ibxeDPBConstantNotSupported, [DPBItem.getParamTypeName])
2366		end;
2367		end;
2368	+	if FConfigOverrides.Count > 0 then
2369	+	Result.Add(isc_dpb_config).SetAsString(FConfigOverrides.Text);
2370		end;
2371
2372		{ GenerateTPB -
#	Line 2394 | Line 2374 | end;
2374		of the transaction parameters, generate a transaction
2375		parameter buffer, and return it and its length in
2376		TPB and TPBLength, respectively. }
2377	<	function GenerateTPB(FirebirdAPI: IFirebirdAPI; sl: TStrings): ITPB;
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 2405 | 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}
2414	<	end;
2415	<	if (Pos(TPBPrefix, ParamName) = 1) then {mbcs ok}
2416	<	Delete(ParamName, 1, Length(TPBPrefix));
2417	<	TPBVal := 0;
2418	<	{ Find the parameter }
2419	<	for j := 1 to isc_tpb_last_tpb_constant do
2420	<	if (ParamName = TPBConstantNames[j]) then
2421	<	begin
2422	<	TPBVal := j;
2423	<	break;
2424	<	end;
2425	<	{ Now act on it }
2426	<	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
2438	<	if (TPBVal > 0) and
2439	<	(TPBVal <= isc_tpb_last_tpb_constant) then
2440	<	IBError(ibxeTPBConstantNotSupported, [TPBConstantNames[TPBVal]])
2441	<	else
2442	<	IBError(ibxeTPBConstantUnknownEx, [sl.Names[i]]);
2443	<	end;
2405	>	IBError(ibxeTPBConstantNotSupported, [TPBItem.getParamTypeName])
2406		end;
2407		end;
2408		end;

Diff Legend

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