38 |
|
|
39 |
|
TIBLocalDBSupport = class(TCustomIBLocalDBSupport) |
40 |
|
private |
41 |
– |
FTargetVersionNo: integer; |
41 |
|
procedure DoDowngrade(Data: PtrInt); |
42 |
< |
procedure HandleDoUpgrade(Sender: TObject); |
42 |
> |
procedure HandleGetDBVersionNo(Sender: TObject; var VersionNo: integer); |
43 |
> |
procedure HandleUpgradeStepCompleted(Sender: TObject); |
44 |
|
protected |
45 |
|
function AllowInitialisation: boolean; override; |
46 |
|
function AllowRestore: boolean; override; |
47 |
< |
function CreateNewDatabase(DBName:string; DBParams: TStrings; DBArchive: string): boolean; override; |
47 |
> |
function InternalCreateNewDatabase(DBName: string; DBParams: TStrings; |
48 |
> |
DBArchive: string): boolean; override; |
49 |
|
procedure Downgrade(DBArchive: string); override; |
50 |
|
function RestoreDatabaseFromArchive(DBName:string; DBParams: TStrings; aFilename: string): boolean; override; |
51 |
|
function RunUpgradeDatabase(TargetVersionNo: integer): boolean; override; |
70 |
|
implementation |
71 |
|
|
72 |
|
uses IBXUpgradeDatabaseDlg, IBXCreateDatabaseDlg, IBXSaveDatabaseDlg, IBServices, |
73 |
< |
IBXUpgradeConfFile, Registry; |
73 |
> |
Registry, IBXCreateDatabaseFromSQLDlgUnit; |
74 |
|
|
75 |
|
resourcestring |
76 |
|
sDowngradePrompt = 'Database Version %d found but Version %d expected. If you have '+ |
82 |
|
'All data in the current database will be lost!'; |
83 |
|
sReplaceInitial = 'This action will replace the current database with an initial database. '+ |
84 |
|
'All data in the current database will be lost!'; |
84 |
– |
sUpdateMsg = 'Applying Update from %s'; |
85 |
– |
sUpdateStarted = '%s Update Started'; |
86 |
– |
sUpdateEnded = '%s Update Completed'; |
87 |
– |
sUpdateFailed = 'Update Failed - %s'; |
85 |
|
|
86 |
|
{ TIBLocalDBSupport } |
87 |
|
|
92 |
|
DowngradeDone; |
93 |
|
end; |
94 |
|
|
95 |
< |
procedure TIBLocalDBSupport.HandleDoUpgrade(Sender: TObject); |
96 |
< |
var UpdateAvailable: boolean; |
97 |
< |
UpgradeInfo: TUpgradeInfo; |
98 |
< |
DBArchive: string; |
99 |
< |
LastVersionNo: integer; |
100 |
< |
begin |
101 |
< |
with (Sender as TUpgradeDatabaseDlg) do |
102 |
< |
repeat |
103 |
< |
if CurrentDBVersionNo >= FTargetVersionNo then break; |
107 |
< |
LastVersionNo := CurrentDBVersionNo; |
108 |
< |
UpdateAvailable := UpgradeConf.GetUpgradeInfo(CurrentDBVersionNo+1,UpgradeInfo); |
109 |
< |
if UpdateAvailable then |
110 |
< |
begin |
111 |
< |
if UpgradeInfo.BackupDB then |
112 |
< |
begin |
113 |
< |
DBArchive := ChangeFileExt(ActiveDatabasePathName,''); |
114 |
< |
DBArchive := DBArchive + '.' + IntToStr(CurrentDBVersionNo) + '.gbk'; |
115 |
< |
SaveDatabase(DBArchive); |
116 |
< |
end; |
117 |
< |
Add2Log(UpgradeInfo.UserMessage); |
118 |
< |
Status.Caption := UpgradeInfo.UserMessage; |
119 |
< |
Application.ProcessMessages; |
120 |
< |
Add2Log(Format(sUpdateMsg,[UpgradeInfo.UpdateSQLFile])); |
121 |
< |
Add2Log(Format(sUpdateStarted,[DateTimeToStr(Now)])); |
122 |
< |
if not IBXScript.PerformUpdate(UpgradeInfo.UpdateSQLFile,true) then |
123 |
< |
begin |
124 |
< |
Add2Log(Format(sUpdateFailed,[DateTimeToStr(Now)])); |
125 |
< |
SuccessfulCompletion := false; |
126 |
< |
break; |
127 |
< |
end; |
128 |
< |
Add2Log(Format(sUpdateEnded,[DateTimeToStr(Now)])); |
129 |
< |
UpdateVersionNo; |
130 |
< |
end; |
131 |
< |
until not UpdateAvailable or (LastVersionNo = CurrentDBVersionNo); |
95 |
> |
procedure TIBLocalDBSupport.HandleGetDBVersionNo(Sender: TObject; |
96 |
> |
var VersionNo: integer); |
97 |
> |
begin |
98 |
> |
VersionNo := CurrentDBVersionNo; |
99 |
> |
end; |
100 |
> |
|
101 |
> |
procedure TIBLocalDBSupport.HandleUpgradeStepCompleted(Sender: TObject); |
102 |
> |
begin |
103 |
> |
UpdateVersionNo; |
104 |
|
end; |
105 |
|
|
106 |
|
function TIBLocalDBSupport.AllowInitialisation: boolean; |
115 |
|
(MessageDlg(sReplaceBackup,mtWarning,[mbOK,mbCancel],0) = mrOK); |
116 |
|
end; |
117 |
|
|
118 |
< |
function TIBLocalDBSupport.CreateNewDatabase(DBName: string; |
118 |
> |
function TIBLocalDBSupport.InternalCreateNewDatabase(DBName: string; |
119 |
|
DBParams: TStrings; DBArchive: string): boolean; |
120 |
+ |
var Ext: string; |
121 |
|
begin |
122 |
|
CreateDir(ExtractFileDir(DBName)); |
123 |
< |
with TCreateDatabaseDlg.Create(Application) do |
124 |
< |
try |
125 |
< |
SetDBParams(IBRestoreService1,DBParams); |
126 |
< |
IBRestoreService1.BackupFile.Clear; |
127 |
< |
IBRestoreService1.DatabaseName.Clear; |
128 |
< |
IBRestoreService1.Options := [CreateNewDB]; |
129 |
< |
IBRestoreService1.BackupFile.Add(DBArchive); |
130 |
< |
IBRestoreService1.DatabaseName.Add(DBName); |
131 |
< |
Result := ShowModal = mrOK; |
132 |
< |
finally |
133 |
< |
Free |
161 |
< |
end; |
123 |
> |
Ext := AnsiUpperCase(ExtractFileExt(DBArchive)); |
124 |
> |
if Ext = '.GBK' then |
125 |
> |
Result := IBXCreateDatabaseDlg.CreateNewDatabase(DBName,DBParams,DBArchive) |
126 |
> |
else |
127 |
> |
if Ext = '.SQL' then |
128 |
> |
begin |
129 |
> |
Database.DatabaseName := DBName; |
130 |
> |
Result := IBXCreateDatabaseFromSQLDlgUnit.CreateNewDatabase(Database,DBArchive) |
131 |
> |
end |
132 |
> |
else |
133 |
> |
raise Exception.CreateFmt('Archive file (%s) has an unknown extension',[DBArchive]); |
134 |
|
end; |
135 |
|
|
136 |
|
procedure TIBLocalDBSupport.Downgrade(DBArchive: string); |
147 |
|
function TIBLocalDBSupport.RestoreDatabaseFromArchive(DBName: string; |
148 |
|
DBParams: TStrings; aFilename: string): boolean; |
149 |
|
begin |
150 |
< |
with TCreateDatabaseDlg.Create(Application) do |
179 |
< |
try |
180 |
< |
if (aFilename = '') or not FileExists(aFileName) then |
181 |
< |
begin |
182 |
< |
OpenDialog1.InitialDir := GetUserDir; |
183 |
< |
if OpenDialog1.Execute then |
184 |
< |
aFilename := OpenDialog1.FileName |
185 |
< |
else |
186 |
< |
Exit; |
187 |
< |
end; |
188 |
< |
SetDBParams(IBRestoreService1,DBParams); |
189 |
< |
IBRestoreService1.BackupFile.Clear; |
190 |
< |
IBRestoreService1.DatabaseName.Clear; |
191 |
< |
IBRestoreService1.Options := [replace]; |
192 |
< |
IBRestoreService1.BackupFile.Add(aFilename); |
193 |
< |
IBRestoreService1.DatabaseName.Add(DBName); |
194 |
< |
Result := ShowModal = mrOK; |
195 |
< |
finally |
196 |
< |
Free |
197 |
< |
end; |
150 |
> |
Result := IBXCreateDatabaseDlg.RestoreDatabaseFromArchive(DBName,DBParams,aFileName); |
151 |
|
end; |
152 |
|
|
153 |
|
function TIBLocalDBSupport.RunUpgradeDatabase(TargetVersionNo: integer |
154 |
|
): boolean; |
155 |
|
begin |
156 |
< |
FTargetVersionNo := TargetVersionNo; |
157 |
< |
with TUpgradeDatabaseDlg.Create(Application) do |
158 |
< |
try |
206 |
< |
IBXScript.Database := Database; |
207 |
< |
UpdateTransaction.DefaultDatabase := Database; |
208 |
< |
OnDoUpgrade := @HandleDoUpgrade; |
209 |
< |
IBXScript.GetParamValue := @HandleGetParamValue; |
210 |
< |
Result := ShowModal = mrOK; |
211 |
< |
finally |
212 |
< |
Free |
213 |
< |
end; |
156 |
> |
Result := IBXUpgradeDatabaseDlg.RunUpgradeDatabase(Database,UpgradeConf, |
157 |
> |
ChangeFileExt(ActiveDatabasePathName,''), |
158 |
> |
TargetVersionNo,@HandleGetDBVersionNo, @HandleUpgradeStepCompleted); |
159 |
|
end; |
160 |
|
|
216 |
– |
{$IFDEF WINDOWS} |
217 |
– |
const |
218 |
– |
rgShellFolders = 'Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders'; |
219 |
– |
rgPersonal = 'Personal'; |
220 |
– |
{$ENDIF} |
221 |
– |
|
161 |
|
function TIBLocalDBSupport.SaveDatabaseToArchive(DBName: string; |
162 |
|
DBParams: TStrings; aFilename: string): boolean; |
163 |
|
begin |
164 |
< |
with TSaveDatabaseDlg.Create(Application) do |
226 |
< |
try |
227 |
< |
if aFilename = '' then |
228 |
< |
begin |
229 |
< |
SaveDialog1.InitialDir := GetUserDir; |
230 |
< |
{$IFDEF WINDOWS} |
231 |
< |
with TRegistry.Create do |
232 |
< |
try |
233 |
< |
if OpenKey(rgShellFolders,false) then |
234 |
< |
begin |
235 |
< |
SaveDialog1.InitialDir := ReadString(rgPersonal) |
236 |
< |
end; |
237 |
< |
finally |
238 |
< |
Free |
239 |
< |
end; |
240 |
< |
{$ENDIF} |
241 |
< |
if SaveDialog1.Execute then |
242 |
< |
aFilename := SaveDialog1.FileName |
243 |
< |
else |
244 |
< |
Exit; |
245 |
< |
end; |
246 |
< |
SetDBParams(IBBackupService1,DBParams); |
247 |
< |
IBBackupService1.BackupFile.Clear; |
248 |
< |
IBBackupService1.DatabaseName := DBName; |
249 |
< |
IBBackupService1.BackupFile.Add(aFilename); |
250 |
< |
Result := ShowModal = mrOK |
251 |
< |
finally |
252 |
< |
Free |
253 |
< |
end; |
164 |
> |
Result := IBXSaveDatabaseDlg.SaveDatabaseToArchive(DBName,DBParams,aFileName); |
165 |
|
end; |
166 |
|
|
167 |
|
end. |