ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/iblocaldb/gui/IBLocalDBSupport.pas
Revision: 315
Committed: Thu Feb 25 11:56:36 2021 UTC (3 years, 1 month ago) by tony
Content type: text/x-pascal
File size: 5279 byte(s)
Log Message:
Updated for IBX 4 release

File Contents

# User Rev Content
1 tony 209 (*
2     * IBX For Lazarus (Firebird Express)
3     *
4     * The contents of this file are subject to the Initial Developer's
5     * Public License Version 1.0 (the "License"); you may not use this
6     * file except in compliance with the License. You may obtain a copy
7     * of the License here:
8     *
9     * http://www.firebirdsql.org/index.php?op=doc&id=idpl
10     *
11     * Software distributed under the License is distributed on an "AS
12     * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
13     * implied. See the License for the specific language governing rights
14     * and limitations under the License.
15     *
16     * The Initial Developer of the Original Code is Tony Whyman.
17     *
18     * The Original Code is (C) 2014 Tony Whyman, MWA Software
19     * (http://www.mwasoftware.co.uk).
20     *
21     * All Rights Reserved.
22     *
23     * Contributor(s): ______________________________________.
24     *
25     *)
26     unit IBLocalDBSupport;
27    
28     {$mode objfpc}{$H+}
29    
30     interface
31    
32     uses
33 tony 272 Classes, SysUtils, LResources, Forms, Controls, Dialogs, IBXCustomIBLocalDBSupport,
34     IBXServices;
35 tony 209
36     type
37    
38     { TIBLocalDBSupport }
39    
40     TIBLocalDBSupport = class(TCustomIBLocalDBSupport)
41     private
42     procedure DoDowngrade(Data: PtrInt);
43     procedure HandleGetDBVersionNo(Sender: TObject; var VersionNo: integer);
44     procedure HandleUpgradeStepCompleted(Sender: TObject);
45     protected
46     function AllowInitialisation: boolean; override;
47     function AllowRestore: boolean; override;
48     function InternalCreateNewDatabase(DBArchive: string): boolean; override;
49     procedure Downgrade(DBArchive: string); override;
50     function RestoreDatabaseFromArchive(aFilename: string): boolean; override;
51     function RunUpgradeDatabase(TargetVersionNo: integer): boolean; override;
52     function SaveDatabaseToArchive(aFilename: string): boolean; override;
53     published
54     property Database;
55     property DatabaseName;
56     property Enabled;
57     property EmptyDBArchive;
58     property FirebirdDirectory;
59     property Options;
60     property RequiredVersionNo;
61 tony 315 property MinimumVersionNo;
62 tony 209 property UpgradeConfFile;
63     property VendorName;
64     property OnGetDatabaseName;
65     property OnGetDBVersionNo;
66     property OnNewDatabaseOpen;
67     property OnGetSharedDataDir;
68     end;
69    
70    
71     implementation
72    
73     uses IBXUpgradeDatabaseDlg, IBXCreateDatabaseDlg, IBXSaveDatabaseDlg,
74     Registry, IBXCreateDatabaseFromSQLDlgUnit;
75    
76     resourcestring
77     sDowngradePrompt = 'Database Version %d found but Version %d expected. If you have '+
78     'reinstalled this application after a failed upgrade then '+
79     'it may be possible to restore a saved archive of the database '+
80     'taken immediately before the upgrade. Do you want to do this?';
81    
82     sReplaceBackup = 'This action will replace the current database with the backup. '+
83     'All data in the current database will be lost!';
84     sReplaceInitial = 'This action will replace the current database with an initial database. '+
85     'All data in the current database will be lost!';
86    
87     { TIBLocalDBSupport }
88    
89     procedure TIBLocalDBSupport.DoDowngrade(Data: PtrInt);
90     begin
91     if AppDestroying in Application.Flags then Exit;
92     RestoreDatabase(DownGradeArchive);
93     DowngradeDone;
94     end;
95    
96     procedure TIBLocalDBSupport.HandleGetDBVersionNo(Sender: TObject;
97     var VersionNo: integer);
98     begin
99     VersionNo := CurrentDBVersionNo;
100     end;
101    
102     procedure TIBLocalDBSupport.HandleUpgradeStepCompleted(Sender: TObject);
103     begin
104     UpdateVersionNo;
105     end;
106    
107     function TIBLocalDBSupport.AllowInitialisation: boolean;
108     begin
109     Result := (iblQuiet in Options) or
110     (MessageDlg(sReplaceInitial, mtWarning,[mbOK,mbCancel],0) = mrOK);
111     end;
112    
113     function TIBLocalDBSupport.AllowRestore: boolean;
114     begin
115     Result := (iblQuiet in Options) or
116     (MessageDlg(sReplaceBackup,mtWarning,[mbOK,mbCancel],0) = mrOK);
117     end;
118    
119     function TIBLocalDBSupport.InternalCreateNewDatabase(DBArchive: string
120     ): boolean;
121     begin
122 tony 272 if IsGBakFile(DBArchive) then
123 tony 209 begin
124     Database.Attachment.Disconnect;
125     try
126     Result := IBXCreateDatabaseDlg.RestoreDatabaseFromArchive(RestoreService,DBArchive)
127     finally
128     Database.Attachment.Connect;
129     end;
130     end
131     else
132     Result := IBXCreateDatabaseFromSQLDlgUnit.CreateNewDatabase(Database,DBArchive)
133     end;
134    
135     procedure TIBLocalDBSupport.Downgrade(DBArchive: string);
136     begin
137     if (iblQuiet in Options) or
138     (MessageDlg(Format(sDowngradePrompt, [CurrentDBVersionNo,RequiredVersionNo]),
139     mtWarning,[mbYes,mbNo],0) = mrYes) then
140     begin
141     inherited Downgrade(DBArchive);
142     Application.QueueAsyncCall(@DoDowngrade,0);
143     end;
144     end;
145    
146     function TIBLocalDBSupport.RestoreDatabaseFromArchive(aFilename: string
147     ): boolean;
148     begin
149     Result := IBXCreateDatabaseDlg.RestoreDatabaseFromArchive(RestoreService,aFileName);
150     end;
151    
152     function TIBLocalDBSupport.RunUpgradeDatabase(TargetVersionNo: integer
153     ): boolean;
154     begin
155     Result := IBXUpgradeDatabaseDlg.RunUpgradeDatabase(Database,BackupService,UpgradeConf,
156     ChangeFileExt(ActiveDatabasePathName,''),
157     TargetVersionNo,@HandleGetDBVersionNo, @HandleUpgradeStepCompleted);
158     end;
159    
160     function TIBLocalDBSupport.SaveDatabaseToArchive(aFilename: string): boolean;
161     begin
162     Result := IBXSaveDatabaseDlg.SaveDatabaseToArchive(BackupService,aFileName);
163     end;
164    
165     end.
166