ViewVC Help

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

root/public/ibx/trunk/iblocaldb/nongui/IBXCustomIBLocalDBSupport.pas

Comparing ibx/trunk/iblocaldb/nongui/IBXCustomIBLocalDBSupport.pas (file contents):
Revision 209 by tony, Wed Mar 14 12:48:51 2018 UTC vs.
Revision 315 by tony, Thu Feb 25 11:56:36 2021 UTC

#	Line 87 | Line 87 | type
87
88		TCustomIBLocalDBSupport = class(TComponent)
89		private
90	+	FMinimumVersionNo: integer;
91		{ Private declarations }
92		FServicesConnection: TIBXServicesConnection;
93		FBackupService: TIBXServerSideBackupService;
#	Line 111 | Line 112 | type
112		FDownGradeArchive: string;
113		FSharedDataDir: string;
114		FUpgradeConf: TUpgradeConfFile;
115	+	FInOnCreateDB: boolean;
116	+	FUpgradeFailed: boolean;
117		procedure CheckEnabled;
118		function GetDatabase: TIBDatabase;
119		function GetSharedDataDir: string;
#	Line 129 | Line 132 | type
132		procedure UpgradeCheck;
133		protected
134		{ Protected declarations }
135	+	procedure Add2Log(Sender: TObject; Msg: string); virtual;
136		function AllowInitialisation: boolean; virtual;
137		function AllowRestore: boolean; virtual;
138		procedure CreateDir(DirName: string);
#	Line 173 | Line 177 | type
177
178		property ActiveDatabasePathName: string read FActiveDatabasePathName;
179		property CurrentDBVersionNo: integer read FCurrentDBVersionNo;
180	+	property InOnCreateDB: boolean read FInOnCreateDB;
181		property SharedDataDir: string read GetSharedDataDir;
182		property ServicesConnection: TIBXServicesConnection read FServicesConnection;
183
#	Line 184 | Line 189 | type
189		property FirebirdDirectory: string read FFirebirdDirectory write SetFirebirdDirectory;
190		property Options: TIBLocalOptions read FOptions write FOptions;
191		property RequiredVersionNo: integer read FRequiredVersionNo write FRequiredVersionNo;
192	+	property MinimumVersionNo: integer read FMinimumVersionNo write FMinimumVersionNo;
193		property UpgradeConfFile: string read FUpgradeConfFile write FUpgradeConfFile;
194		property VendorName: string read FVendorName write FVendorName;
195		property OnGetDatabaseName: TOnGetDatabaseName read FOnGetDatabaseName write FOnGetDatabaseName;
#	Line 197 | Line 203 | type
203		implementation
204
205		{$IFDEF Unix} uses initc, regexpr {$ENDIF}
206	<	{$IFDEF WINDOWS} uses Windows ,Windirs {$ENDIF}, IBUtils;
206	>	{$IFDEF WINDOWS} uses Windows ,Windirs {$ENDIF}, IBUtils, IBMessages;
207
208		resourcestring
209		sNoDowngrade = 'Database Schema is %d. Unable to downgrade to version %d';
#	Line 206 | Line 212 | resourcestring
212		sEmptyDBArchiveNotFound = 'Unable to create database - empty DB archive file (%s) not found';
213		sNoEmbeddedServer = 'Firebird Embedded Server is required but is not installed';
214		sCreateFailed = 'Unable to Create Personal Database';
215	+	sDowngrade = 'Downgrading to version %d';
216	+	sSkipUpgrade = 'Previous attempt at upgrade to %d failed. Skipping upgrade';
217
218		{ TCustomIBLocalDBSupport }
219
#	Line 282 | Line 290 | end;
290		procedure TCustomIBLocalDBSupport.OnBeforeDatabaseConnect(Sender: TObject;
291		DBParams: TStrings; var DBName: string; var CreateIfNotExists: boolean);
292		begin
293	<	if not Enabled or (csDesigning in ComponentState) then Exit;
293	>	if FInOnCreateDB or not Enabled or (csDesigning in ComponentState) then Exit;
294
295	<	if not FirebirdAPI.IsEmbeddedServer then
295	>	if not assigned(Database) or not Database.FirebirdAPI.IsEmbeddedServer then
296		raise EIBLocalFatalError.Create(sNoEmbeddedServer);
297
298		DBName := GetDBNameAndPath;
#	Line 293 | Line 301 | begin
301		SetupFirebirdEnv;
302		CreateIfNotExists := true;
303		PrepareDBParams(DBParams);
304	+	ServicesConnection.SetDBParams(DBParams);
305		end;
306
307		procedure TCustomIBLocalDBSupport.OnDatabaseConnected(Sender: TObject);
308		begin
309	+	if FInOnCreateDB then Exit;
310		if not Enabled or (csDesigning in ComponentState) or
311		FInUpgrade then Exit; {Avoids problem if RECONNECT used in script}
312
#	Line 315 | Line 325 | end;
325		procedure TCustomIBLocalDBSupport.OnCreateDatabase(Sender: TObject);
326		var DBArchive: string;
327		begin
328	<	CheckEnabled;
319	<	DBArchive := EmptyDBArchive;
320	<	if DBArchive = '' then
321	<	raise EIBLocalException.Create(sEmptyDBArchiveMissing);
328	>	if FInOnCreateDB then Exit;
329
330	<	if not TUpgradeConfFile.IsAbsolutePath(DBArchive) then
324	<	DBArchive := SharedDataDir + DBArchive;
325	<
326	<	if not FileExists(DBArchive) then
327	<	raise EIBLocalException.CreateFmt(sEmptyDBArchiveNotFound,[DBArchive]);
328	<
329	<	ServicesConnection.ConnectUsing(Database);
330	>	FInOnCreateDB := true;
331		try
332	<	if not InternalCreateNewDatabase(DBArchive) then
333	<	begin
334	<	Database.DropDatabase;
335	<	raise EIBLocalException.Create(sCreateFailed);
332	>	CheckEnabled;
333	>	DBArchive := EmptyDBArchive;
334	>	if DBArchive = '' then
335	>	raise EIBLocalException.Create(sEmptyDBArchiveMissing);
336	>
337	>	if not TUpgradeConfFile.IsAbsolutePath(DBArchive) then
338	>	DBArchive := SharedDataDir + DBArchive;
339	>
340	>	if not FileExists(DBArchive) then
341	>	raise EIBLocalException.CreateFmt(sEmptyDBArchiveNotFound,[DBArchive]);
342	>
343	>	ServicesConnection.ConnectUsing(Database);
344	>	try
345	>	if not InternalCreateNewDatabase(DBArchive) then
346	>	begin
347	>	Database.DropDatabase;
348	>	raise EIBLocalException.Create(sCreateFailed);
349	>	end;
350	>	finally
351	>	ServicesConnection.Connected := false;
352		end;
353	+	FNewDBCreated := true;
354		finally
355	<	ServicesConnection.Connected := false;
355	>	FInOnCreateDB := false;
356		end;
339	–	FNewDBCreated := true;
357		end;
358
359		procedure TCustomIBLocalDBSupport.SetFirebirdDirectory(AValue: string);
#	Line 378 | Line 395 | begin
395		PerformDowngrade(RequiredVersionNo)
396		else
397		if (CurrentDBVersionNo < RequiredVersionNo) and (iblAutoUpgrade in FOptions) then
398	<	PerformUpgrade(RequiredVersionNo);
398	>	begin
399	>	if FUpgradeFailed then
400	>	begin
401	>	Add2Log(self,Format(sSkipUpgrade,[RequiredVersionNo]));
402	>	if MinimumVersionNo > CurrentDBVersionNo then
403	>	begin
404	>	Database.ForceClose;
405	>	IBError(ibxDBVersionProblem,[CurrentDBVersionNo, MinimumVersionNo]);
406	>	end
407	>	end
408	>	else
409	>	PerformUpgrade(RequiredVersionNo);
410	>	end;
411	>	end;
412	>
413	>	procedure TCustomIBLocalDBSupport.Add2Log(Sender: TObject; Msg: string);
414	>	begin
415	>	//Do nothing
416		end;
417
418		function TCustomIBLocalDBSupport.AllowInitialisation: boolean;
#	Line 441 | Line 475 | procedure TCustomIBLocalDBSupport.Prepar
475		end;
476
477		begin
478	+	{$IFDEF UNIX}
479	+	if Database.FirebirdAPI.GetClientMajor >= 3 then
480	+	begin
481		Remove('user_name');
482		Remove('password');
483		DBParams.Values['user_name'] := 'SYSDBA';
484	<	{$IFDEF WINDOWS}
485	<	DBParams.Values['password'] := 'masterkey';
486	<	{$ENDIF}
484	>	end;
485	>	{$ENDIF}
486	>	{$IFDEF WINDOWS}
487	>	DBParams.Values['user_name'] := 'SYSDBA';
488	>	DBParams.Values['password'] := 'masterkey';
489	>	{$ENDIF}
490		end;
491
492		procedure TCustomIBLocalDBSupport.SetDatabaseName(AValue: string);
#	Line 477 | Line 517 | begin
517		FServicesConnection.LoginPrompt := false;
518		FServicesConnection.Params.Values['user_name'] := 'SYSDBA';
519		FBackupService := TIBXServerSideBackupService.Create(self);
520	<	FBackupService.ServicesConnection := FServicesConnection;
520	>	FBackupService.ServicesConnection := ServicesConnection;
521		FBackupService.Verbose := true;
522		FRestoreService := TIBXServerSideRestoreService.Create(self);
523	<	FRestoreService.ServicesConnection := FServicesConnection;
523	>	FRestoreService.ServicesConnection := ServicesConnection;
524		FRestoreService.Verbose := true;
525		end;
526
#	Line 510 | Line 550 | begin
550		DBArchive := ChangeFileExt(ActiveDatabasePathName,'') +
551		'.' + IntToStr(TargetVersionNo) + '.gbk';
552		if FileExists(DBArchive) then
553	+	begin
554	+	Add2Log(self,Format(sDowngrade,[TargetVersionNo]));
555		Downgrade(DBArchive)
556	+	end
557		else
558		raise EIBLocalFatalError.CreateFmt(sNoDowngrade,[CurrentDBVersionNo,TargetVersionNo]);
559		end;
#	Line 526 | Line 569 | procedure TCustomIBLocalDBSupport.Perfor
569		Result := SharedDataDir + Result;
570		end;
571
572	+	var OldVersionNo: integer;
573	+
574		begin
575		if FInUpgrade then Exit;
576
577	+	OldVersionNo := CurrentDBVersionNo;
578		FUpgradeConf := TUpgradeConfFile.Create(GetUpgradeConfFile);
579		try
580		FUpgradeConf.CheckUpgradeAvailable(TargetVersionNo);
#	Line 536 | Line 582 | begin
582		try
583		ServicesConnection.ConnectUsing(Database);
584		try
585	<	RunUpgradeDatabase(TargetVersionNo);
585	>	if not RunUpgradeDatabase(TargetVersionNo) then
586	>	begin
587	>	{DownGrade if possible}
588	>	PerformDowngrade(OldVersionNo);
589	>	Database.ForceClose;
590	>	FUpgradeFailed := true;
591	>	IBError(ibxeUpgradeFailed,[CurrentDBVersionNo]);
592	>	end;
593		finally
594		ServicesConnection.Connected := false;
595		end;
#	Line 546 | Line 599 | begin
599		finally
600		FreeAndNil(FUpgradeConf);
601		end;
602	+	FUpgradeFailed := false;
603	+	if CurrentDBVersionNo < MinimumVersionNo then
604	+	begin
605	+	Database.ForceClose;
606	+	IBError(ibxDBVersionProblem,[CurrentDBVersionNo,MinimumVersionNo]);
607	+	end;
608		end;
609
610		procedure TCustomIBLocalDBSupport.Loaded;

Diff Legend

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