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 345 by tony, Mon Aug 23 14:22:29 2021 UTC

#	Line 87 | Line 87 | type
87
88		TCustomIBLocalDBSupport = class(TComponent)
89		private
90	+	FMinimumVersionNo: integer;
91	+	FSectionHeaderTemplate: string;
92		{ Private declarations }
93		FServicesConnection: TIBXServicesConnection;
94		FBackupService: TIBXServerSideBackupService;
#	Line 111 | Line 113 | type
113		FDownGradeArchive: string;
114		FSharedDataDir: string;
115		FUpgradeConf: TUpgradeConfFile;
116	+	FInOnCreateDB: boolean;
117	+	FUpgradeFailed: boolean;
118		procedure CheckEnabled;
119		function GetDatabase: TIBDatabase;
120		function GetSharedDataDir: string;
#	Line 129 | Line 133 | type
133		procedure UpgradeCheck;
134		protected
135		{ Protected declarations }
136	+	procedure Add2Log(Sender: TObject; Msg: string); virtual;
137		function AllowInitialisation: boolean; virtual;
138		function AllowRestore: boolean; virtual;
139		procedure CreateDir(DirName: string);
#	Line 173 | Line 178 | type
178
179		property ActiveDatabasePathName: string read FActiveDatabasePathName;
180		property CurrentDBVersionNo: integer read FCurrentDBVersionNo;
181	+	property InOnCreateDB: boolean read FInOnCreateDB;
182		property SharedDataDir: string read GetSharedDataDir;
183		property ServicesConnection: TIBXServicesConnection read FServicesConnection;
184
#	Line 184 | Line 190 | type
190		property FirebirdDirectory: string read FFirebirdDirectory write SetFirebirdDirectory;
191		property Options: TIBLocalOptions read FOptions write FOptions;
192		property RequiredVersionNo: integer read FRequiredVersionNo write FRequiredVersionNo;
193	+	property MinimumVersionNo: integer read FMinimumVersionNo write FMinimumVersionNo;
194		property UpgradeConfFile: string read FUpgradeConfFile write FUpgradeConfFile;
195	+	property SectionHeaderTemplate: string read FSectionHeaderTemplate write FSectionHeaderTemplate;
196		property VendorName: string read FVendorName write FVendorName;
197		property OnGetDatabaseName: TOnGetDatabaseName read FOnGetDatabaseName write FOnGetDatabaseName;
198		property OnGetDBVersionNo: TOnGetDBVersionNo read FOnGetDBVersionNo write FOnGetDBVersionNo;
#	Line 197 | Line 205 | type
205		implementation
206
207		{$IFDEF Unix} uses initc, regexpr {$ENDIF}
208	<	{$IFDEF WINDOWS} uses Windows ,Windirs {$ENDIF}, IBUtils;
208	>	{$IFDEF WINDOWS} uses Windows ,Windirs {$ENDIF}, IBUtils, IBMessages;
209	>
210	>	const
211	>	sSectionheader      = 'Version.%.3d';
212
213		resourcestring
214		sNoDowngrade = 'Database Schema is %d. Unable to downgrade to version %d';
#	Line 206 | Line 217 | resourcestring
217		sEmptyDBArchiveNotFound = 'Unable to create database - empty DB archive file (%s) not found';
218		sNoEmbeddedServer = 'Firebird Embedded Server is required but is not installed';
219		sCreateFailed = 'Unable to Create Personal Database';
220	+	sDowngrade = 'Downgrading to version %d';
221	+	sSkipUpgrade = 'Previous attempt at upgrade to %d failed. Skipping upgrade';
222
223		{ TCustomIBLocalDBSupport }
224
#	Line 282 | Line 295 | end;
295		procedure TCustomIBLocalDBSupport.OnBeforeDatabaseConnect(Sender: TObject;
296		DBParams: TStrings; var DBName: string; var CreateIfNotExists: boolean);
297		begin
298	<	if not Enabled or (csDesigning in ComponentState) then Exit;
298	>	if FInOnCreateDB or not Enabled or (csDesigning in ComponentState) then Exit;
299
300	<	if not FirebirdAPI.IsEmbeddedServer then
300	>	if not assigned(Database) or not Database.FirebirdAPI.IsEmbeddedServer then
301		raise EIBLocalFatalError.Create(sNoEmbeddedServer);
302
303		DBName := GetDBNameAndPath;
#	Line 293 | Line 306 | begin
306		SetupFirebirdEnv;
307		CreateIfNotExists := true;
308		PrepareDBParams(DBParams);
309	+	ServicesConnection.SetDBParams(DBParams);
310		end;
311
312		procedure TCustomIBLocalDBSupport.OnDatabaseConnected(Sender: TObject);
313		begin
314	+	if FInOnCreateDB then Exit;
315		if not Enabled or (csDesigning in ComponentState) or
316		FInUpgrade then Exit; {Avoids problem if RECONNECT used in script}
317
#	Line 315 | Line 330 | end;
330		procedure TCustomIBLocalDBSupport.OnCreateDatabase(Sender: TObject);
331		var DBArchive: string;
332		begin
333	<	CheckEnabled;
319	<	DBArchive := EmptyDBArchive;
320	<	if DBArchive = '' then
321	<	raise EIBLocalException.Create(sEmptyDBArchiveMissing);
322	<
323	<	if not TUpgradeConfFile.IsAbsolutePath(DBArchive) then
324	<	DBArchive := SharedDataDir + DBArchive;
325	<
326	<	if not FileExists(DBArchive) then
327	<	raise EIBLocalException.CreateFmt(sEmptyDBArchiveNotFound,[DBArchive]);
333	>	if FInOnCreateDB then Exit;
334
335	<	ServicesConnection.ConnectUsing(Database);
335	>	FInOnCreateDB := true;
336		try
337	<	if not InternalCreateNewDatabase(DBArchive) then
338	<	begin
339	<	Database.DropDatabase;
340	<	raise EIBLocalException.Create(sCreateFailed);
337	>	CheckEnabled;
338	>	DBArchive := EmptyDBArchive;
339	>	if DBArchive = '' then
340	>	raise EIBLocalException.Create(sEmptyDBArchiveMissing);
341	>
342	>	if not TUpgradeConfFile.IsAbsolutePath(DBArchive) then
343	>	DBArchive := SharedDataDir + DBArchive;
344	>
345	>	if not FileExists(DBArchive) then
346	>	raise EIBLocalException.CreateFmt(sEmptyDBArchiveNotFound,[DBArchive]);
347	>
348	>	ServicesConnection.ConnectUsing(Database);
349	>	try
350	>	if not InternalCreateNewDatabase(DBArchive) then
351	>	begin
352	>	Database.DropDatabase;
353	>	raise EIBLocalException.Create(sCreateFailed);
354	>	end;
355	>	finally
356	>	ServicesConnection.Connected := false;
357		end;
358	+	FNewDBCreated := true;
359		finally
360	<	ServicesConnection.Connected := false;
360	>	FInOnCreateDB := false;
361		end;
339	–	FNewDBCreated := true;
362		end;
363
364		procedure TCustomIBLocalDBSupport.SetFirebirdDirectory(AValue: string);
#	Line 378 | Line 400 | begin
400		PerformDowngrade(RequiredVersionNo)
401		else
402		if (CurrentDBVersionNo < RequiredVersionNo) and (iblAutoUpgrade in FOptions) then
403	<	PerformUpgrade(RequiredVersionNo);
403	>	begin
404	>	if FUpgradeFailed then
405	>	begin
406	>	Add2Log(self,Format(sSkipUpgrade,[RequiredVersionNo]));
407	>	if MinimumVersionNo > CurrentDBVersionNo then
408	>	begin
409	>	Database.ForceClose;
410	>	IBError(ibxDBVersionProblem,[CurrentDBVersionNo, MinimumVersionNo]);
411	>	end
412	>	end
413	>	else
414	>	PerformUpgrade(RequiredVersionNo);
415	>	end;
416	>	end;
417	>
418	>	procedure TCustomIBLocalDBSupport.Add2Log(Sender: TObject; Msg: string);
419	>	begin
420	>	//Do nothing
421		end;
422
423		function TCustomIBLocalDBSupport.AllowInitialisation: boolean;
#	Line 441 | Line 480 | procedure TCustomIBLocalDBSupport.Prepar
480		end;
481
482		begin
483	+	{$IFDEF UNIX}
484	+	if Database.FirebirdAPI.GetClientMajor >= 3 then
485	+	begin
486		Remove('user_name');
487		Remove('password');
488		DBParams.Values['user_name'] := 'SYSDBA';
489	<	{$IFDEF WINDOWS}
490	<	DBParams.Values['password'] := 'masterkey';
491	<	{$ENDIF}
489	>	end;
490	>	{$ENDIF}
491	>	{$IFDEF WINDOWS}
492	>	DBParams.Values['user_name'] := 'SYSDBA';
493	>	DBParams.Values['password'] := 'masterkey';
494	>	{$ENDIF}
495		end;
496
497		procedure TCustomIBLocalDBSupport.SetDatabaseName(AValue: string);
#	Line 477 | Line 522 | begin
522		FServicesConnection.LoginPrompt := false;
523		FServicesConnection.Params.Values['user_name'] := 'SYSDBA';
524		FBackupService := TIBXServerSideBackupService.Create(self);
525	<	FBackupService.ServicesConnection := FServicesConnection;
525	>	FBackupService.ServicesConnection := ServicesConnection;
526		FBackupService.Verbose := true;
527		FRestoreService := TIBXServerSideRestoreService.Create(self);
528	<	FRestoreService.ServicesConnection := FServicesConnection;
528	>	FRestoreService.ServicesConnection := ServicesConnection;
529		FRestoreService.Verbose := true;
530	+	FSectionHeaderTemplate := sSectionheader;
531		end;
532
533		destructor TCustomIBLocalDBSupport.Destroy;
#	Line 510 | Line 556 | begin
556		DBArchive := ChangeFileExt(ActiveDatabasePathName,'') +
557		'.' + IntToStr(TargetVersionNo) + '.gbk';
558		if FileExists(DBArchive) then
559	+	begin
560	+	Add2Log(self,Format(sDowngrade,[TargetVersionNo]));
561		Downgrade(DBArchive)
562	+	end
563		else
564		raise EIBLocalFatalError.CreateFmt(sNoDowngrade,[CurrentDBVersionNo,TargetVersionNo]);
565		end;
#	Line 526 | Line 575 | procedure TCustomIBLocalDBSupport.Perfor
575		Result := SharedDataDir + Result;
576		end;
577
578	+	var OldVersionNo: integer;
579	+
580		begin
581		if FInUpgrade then Exit;
582
583	+	OldVersionNo := CurrentDBVersionNo;
584		FUpgradeConf := TUpgradeConfFile.Create(GetUpgradeConfFile);
585		try
586		FUpgradeConf.CheckUpgradeAvailable(TargetVersionNo);
#	Line 536 | Line 588 | begin
588		try
589		ServicesConnection.ConnectUsing(Database);
590		try
591	<	RunUpgradeDatabase(TargetVersionNo);
591	>	if not RunUpgradeDatabase(TargetVersionNo) then
592	>	begin
593	>	{DownGrade if possible}
594	>	PerformDowngrade(OldVersionNo);
595	>	Database.ForceClose;
596	>	FUpgradeFailed := true;
597	>	IBError(ibxeUpgradeFailed,[CurrentDBVersionNo]);
598	>	end;
599		finally
600		ServicesConnection.Connected := false;
601		end;
#	Line 546 | Line 605 | begin
605		finally
606		FreeAndNil(FUpgradeConf);
607		end;
608	+	FUpgradeFailed := false;
609	+	if CurrentDBVersionNo < MinimumVersionNo then
610	+	begin
611	+	Database.ForceClose;
612	+	IBError(ibxDBVersionProblem,[CurrentDBVersionNo,MinimumVersionNo]);
613	+	end;
614		end;
615
616		procedure TCustomIBLocalDBSupport.Loaded;

Diff Legend

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