ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/iblocaldb/IBXCustomIBLocalDBSupport.pas
Revision: 80
Committed: Mon Jan 1 11:31:07 2018 UTC (6 years, 2 months ago) by tony
Content type: text/x-pascal
File size: 21200 byte(s)
Log Message:
Fixes merged into public release

File Contents

# Content
1 (*
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 IBXCustomIBLocalDBSupport;
27
28 {$mode objfpc}{$H+}
29
30 interface
31
32 uses
33 Classes, IBDatabase, SysUtils, IBServices, IBXUpgradeConfFile, ibxscript,
34 IB;
35
36 type
37
38 { TCustomIBLocalDBSupport Properties
39
40 * Database: reference to the TIBDatabase component for the local database
41 * DatabaseName: filename (no path) to use for the Firebird Database file.
42 * EmptyDBArchive: filename (optional path) holding the database initialisation archive.
43 May either be absolute path or relative to shared data directory.
44 * Enabled: when false component does nothing
45 * FirebirdDirectory: Full path to directory holding firebird.conf. May either be
46 absolute path or relative to the shared data directory. If empty, defaults to shared data directory.
47 * Name: Component Name
48 * Options:
49 iblAutoUpgrade: Automatically apply upgrade when database schema
50 version is lower than required.
51 IblAllowDowngrade: Automatically apply downgrade when available to
52 schema version compatible with the required version.
53 iblQuiet: true then no database overwrite warnings
54 * RequiredVersionNo: The schema version number required by the application.
55 TIBLocalDBSupport will normally try to upgrade/downgrade the schema to satisfy
56 this requirement.
57 * UpgradeConfFile: Path to upgrade configuration file. May either be absolute
58 path or relative to the shared data directory.
59 * VendorName: Used to construct path to Database Directory.
60
61 Note that at design time paths may use '/' or '\' as directory separator. At
62 run time, they must be specified using the appropriate Directory Separator
63 for the current platform.
64
65 Events:
66
67 * OnGetDatabaseName: The database name is normally computed automatically.
68 However, this event allows an application to inspect and override the result.
69 * OnNewDatabaseOpen: called after the successful initialisation of an empty local database.
70 * OnGetDBVersionNo: called to get the current database schema version number.
71 If this event is not handled then schema upgrade/downgrade is never performed.
72 * OnGetSharedDataDir: The shared data directory is normally computed automatically.
73 However, this event allows an application to inspect and override the result.
74 }
75
76 TOnGetDatabaseName = procedure(Sender: TObject; var DBName: string) of object;
77 TOnGetDBVersionNo = procedure (Sender: TObject; var VersionNo: integer) of object;
78 TOnGetSharedDataDir = procedure(Sender: TObject; var SharedDataDir: string) of object;
79
80 TIBLocalOption = (iblAutoUpgrade, iblAllowDowngrade, iblQuiet);
81 TIBLocalOptions = set of TIBLocalOption;
82
83 EIBLocalException = class(Exception);
84
85
86 { TCustomIBLocalDBSupport }
87
88 TCustomIBLocalDBSupport = class(TComponent)
89 private
90 { Private declarations }
91 FActiveDatabasePathName: string;
92 FCurrentDBVersionNo: integer;
93 FEmptyDBArchive: string;
94 FEnabled: boolean;
95 FFirebirdDirectory: string;
96 FIBBase: TIBBase;
97 FDatabaseName: string;
98 FOnGetDatabaseName: TOnGetDatabaseName;
99 FOnGetDBVersionNo: TOnGetDBVersionNo;
100 FOnGetSharedDataDir: TOnGetSharedDataDir;
101 FOnNewDatabaseOpen: TNotifyEvent;
102 FOptions: TIBLocalOptions;
103 FRequiredVersionNo: integer;
104 FUpgradeConfFile: string;
105 FNewDBCreated: boolean;
106 FVendorName: string;
107 FInUpgrade: boolean;
108 FDownGradeArchive: string;
109 FSharedDataDir: string;
110 FUpgradeConf: TUpgradeConfFile;
111 FInCreateNew: boolean;
112 FSavedAfterConnect: TNotifyEvent;
113 FSavedAfterDisconnect: TNotifyEvent;
114 FSavedBeforeConnect: TNotifyEvent;
115 FSavedBeforeDisconnect: TNotifyEvent;
116 procedure CheckEnabled;
117 procedure CreateDatabase(DBName: string; DBParams: TStrings; Overwrite: boolean);
118 function GetDatabase: TIBDatabase;
119 function GetSharedDataDir: string;
120 procedure SetDatabase(AValue: TIBDatabase);
121 function GetDBNameAndPath: string;
122 procedure InitDatabaseParameters(DBParams: TStrings;
123 var DBName: string);
124 function MapSharedDataDir(aDataDir: string): string;
125 procedure OnBeforeDatabaseConnect(Sender: TObject; DBParams: TStrings;
126 var DBName: string);
127 procedure OnDatabaseConnect(Sender: TObject);
128 procedure OnAfterDatabaseDisconnect(Sender: TObject);
129 procedure PrepareDBParams(DBParams: TStrings);
130 procedure SetDatabaseName(AValue: string);
131 procedure SetFirebirdDirectory(AValue: string);
132 procedure SetupFirebirdEnv;
133 procedure UpgradeCheck;
134 procedure SaveEvents;
135 procedure RestoreEvents;
136 protected
137 { Protected declarations }
138 function AllowInitialisation: boolean; virtual;
139 function AllowRestore: boolean; virtual;
140 procedure CreateDir(DirName: string);
141 function InternalCreateNewDatabase(DBName:string; DBParams: TStrings; DBArchive: string): boolean; virtual; abstract;
142 function CreateNewDatabase(DBName:string; DBParams: TStrings; DBArchive: string): boolean;
143 procedure Downgrade(DBArchive: string); virtual;
144 procedure DowngradeDone;
145 procedure Loaded; override;
146 function RestoreDatabaseFromArchive(DBName:string; DBParams: TStrings; aFilename: string): boolean; virtual; abstract;
147 function RunUpgradeDatabase(TargetVersionNo: integer): boolean; virtual; abstract;
148 function SaveDatabaseToArchive(DBName: string; DBParams:TStrings; aFilename: string): boolean; virtual; abstract;
149 function UpdateVersionNo: boolean;
150 property DownGradeArchive: string read FDownGradeArchive;
151 property UpgradeConf: TUpgradeConfFile read FUpgradeConf;
152 public
153 { Public declarations }
154 constructor Create(aOwner: TComponent); override;
155 destructor Destroy; override;
156
157 function DowngradePending: boolean;
158
159 {NewDatabase: called to reinitialise the local database using the initialisation
160 archive. Overwrites existing data so use carefully.}
161 procedure NewDatabase;
162
163 {Perform a downgrade to target version if backup archive available.
164 Note: normally called from UpgradeCheck if iblAllowDowngrade in Options}
165 procedure PerformDowngrade(TargetVersionNo: integer);
166
167 {Perform schema upgrade to target version if upgrade scripts available.
168 Note: normally called from UpgradeCheck if iblAllowUpgrade in Options}
169 procedure PerformUpgrade(TargetVersionNo: integer);
170
171 {RestoreDatabase: overwrites the existing local database with the specified
172 gbak format archive. User is prompted to locate archive if filename empty.}
173 procedure RestoreDatabase (filename: string = '');
174
175 {SaveDatabase: Saves the current database into a gbak format archive. User
176 is prompted for archive filename if filename empty.}
177 procedure SaveDatabase(filename: string = '');
178
179 property ActiveDatabasePathName: string read FActiveDatabasePathName;
180 property CurrentDBVersionNo: integer read FCurrentDBVersionNo;
181 property SharedDataDir: string read GetSharedDataDir;
182
183 { Likely to be Published declarations }
184 property Database: TIBDatabase read GetDatabase write SetDatabase;
185 property DatabaseName: string read FDatabaseName write SetDatabaseName;
186 property Enabled: boolean read FEnabled write FEnabled default true;
187 property EmptyDBArchive: string read FEmptyDBArchive write FEmptyDBArchive;
188 property FirebirdDirectory: string read FFirebirdDirectory write SetFirebirdDirectory;
189 property Options: TIBLocalOptions read FOptions write FOptions;
190 property RequiredVersionNo: integer read FRequiredVersionNo write FRequiredVersionNo;
191 property UpgradeConfFile: string read FUpgradeConfFile write FUpgradeConfFile;
192 property VendorName: string read FVendorName write FVendorName;
193 property OnGetDatabaseName: TOnGetDatabaseName read FOnGetDatabaseName write FOnGetDatabaseName;
194 property OnGetDBVersionNo: TOnGetDBVersionNo read FOnGetDBVersionNo write FOnGetDBVersionNo;
195 property OnNewDatabaseOpen: TNotifyEvent read FOnNewDatabaseOpen write FOnNewDatabaseOpen;
196 property OnGetSharedDataDir: TOnGetSharedDataDir read FOnGetSharedDataDir write FOnGetSharedDataDir;
197 end;
198
199 EIBLocalFatalError = class(Exception);
200
201 implementation
202
203 {$IFDEF Unix} uses initc, regexpr {$ENDIF}
204 {$IFDEF WINDOWS} uses Windows ,Windirs {$ENDIF};
205
206 resourcestring
207 sNoDowngrade = 'Database Schema is %d. Unable to downgrade to version %d';
208 sLocalDBDisabled = 'Local Database Access Disabled';
209 sEmptyDBArchiveMissing = 'Unable to create database - no empty DB archive specified';
210 sEmptyDBArchiveNotFound = 'Unable to create database - empty DB archive file (%s) not found';
211 sNoEmbeddedServer = 'Firebird Embedded Server is required but is not installed';
212 sCreateFailed = 'Unable to Create Personal Database';
213
214 { TCustomIBLocalDBSupport }
215
216
217 procedure TCustomIBLocalDBSupport.CheckEnabled;
218 begin
219 if not Enabled then
220 raise EIBLocalException.Create(sLocalDBDisabled);
221 end;
222
223 procedure TCustomIBLocalDBSupport.CreateDatabase(DBName: string; DBParams: TStrings;
224 Overwrite: boolean);
225 var DBArchive: string;
226 begin
227 CheckEnabled;
228 DBArchive := EmptyDBArchive;
229 if DBArchive = '' then
230 raise EIBLocalException.Create(sEmptyDBArchiveMissing);
231
232 if not TUpgradeConfFile.IsAbsolutePath(DBArchive) then
233 DBArchive := SharedDataDir + DBArchive;
234
235 if not FileExists(DBArchive) then
236 raise EIBLocalException.CreateFmt(sEmptyDBArchiveNotFound,[DBArchive]);
237
238 if FileExists(DBName) then
239 begin
240 if not Overwrite then Exit;
241
242 sysutils.DeleteFile(DBName);
243 end;
244
245 SetupFirebirdEnv;
246 SaveEvents;
247 try
248 if not CreateNewDatabase(DBName,DBParams,DBArchive) then
249 begin
250 Database.Connected := true;
251 Database.DropDatabase;
252 raise EIBLocalException.Create(sCreateFailed);
253 end
254 else
255 FNewDBCreated := true;
256 finally
257 RestoreEvents;
258 end;
259 end;
260
261 function TCustomIBLocalDBSupport.GetDatabase: TIBDatabase;
262 begin
263 Result := FIBBase.Database;
264 end;
265
266 function TCustomIBLocalDBSupport.GetSharedDataDir: string;
267 begin
268 if FSharedDataDir = '' then
269 FSharedDataDir := MapSharedDataDir(ExtractFilePath(ParamStr(0)));
270 Result := FSharedDataDir;
271 end;
272
273 procedure TCustomIBLocalDBSupport.SetDatabase(AValue: TIBDatabase);
274 begin
275 FIBBase.Database := AValue;
276 end;
277
278 function TCustomIBLocalDBSupport.MapSharedDataDir(aDataDir: string): string;
279 {$IFDEF UNIX}
280 var RegexObj: TRegExpr;
281 {$ENDIF}
282 begin
283 Result := aDataDir;
284 {$IFDEF UNIX}
285
286 {Under Unix transform application exe paths that are in installed locations
287 e.g. /usr/local/bin to corresponding shared data locations e.g. /usr/local/shared}
288 RegexObj := TRegExpr.Create;
289 try
290 RegexObj.Expression := '^/usr(/local|)/(s|)bin/.*$';
291 if RegexObj.Exec(aDataDir) then
292 Result := '/usr' + RegexObj.Match[1] + '/share/' + ApplicationName + '/';
293 finally
294 RegexObj.Free;
295 end;
296 {$ENDIF}
297 if assigned (FOnGetSharedDataDir) then
298 OnGetSharedDataDir(self,Result);
299 {Ensure a trailing separator}
300 if (Length(Result) > 0) and (Result[Length(Result)] <> DirectorySeparator) then
301 Result := Result + DirectorySeparator;
302 end;
303
304 {$IFDEF Unix}
305 function setenv(name:Pchar; value:Pchar; replace:integer):integer;cdecl;external clib name 'setenv';
306 function unsetenv(name:Pchar):integer;cdecl;external clib name 'unsetenv';
307 function SetEnvironmentVariable(name:PChar; value:PChar):boolean;
308 // Set environment variable; if empty string given, remove it.
309 begin
310 result:=false; //assume failure
311 if value = '' then
312 begin
313 // Assume user wants to remove variable.
314 if unsetenv(name)=0 then result:=true;
315 end
316 else
317 begin
318 // Non empty so set the variable
319 if setenv(name, value, 1)=0 then result:=true;
320 end;
321 end;
322 {$ENDIF}
323
324 procedure TCustomIBLocalDBSupport.OnBeforeDatabaseConnect(Sender: TObject;
325 DBParams: TStrings; var DBName: string);
326 begin
327 if FInCreateNew or not Enabled or (csDesigning in ComponentState) then Exit;
328
329 if not FirebirdAPI.IsEmbeddedServer then
330 raise EIBLocalFatalError.Create(sNoEmbeddedServer);
331
332 InitDatabaseParameters(DBParams,DBName);
333 FActiveDatabasePathName := DBName;
334 SetupFirebirdEnv;
335 end;
336
337 procedure TCustomIBLocalDBSupport.OnDatabaseConnect(Sender: TObject);
338 begin
339 if not Enabled or (csDesigning in ComponentState) or
340 FInUpgrade then Exit; {Avoids problem if RECONNECT used in script}
341
342 UpgradeCheck;
343
344 if not DowngradePending and FNewDBCreated and assigned(FOnNewDatabaseOpen) then
345 OnNewDatabaseOpen(self);
346 FNewDBCreated := false;
347
348 end;
349
350 procedure TCustomIBLocalDBSupport.OnAfterDatabaseDisconnect(Sender: TObject);
351 begin
352 FActiveDatabasePathName := '';
353 end;
354
355 procedure TCustomIBLocalDBSupport.SetFirebirdDirectory(AValue: string);
356 begin
357 if FFirebirdDirectory = AValue then Exit;
358 FFirebirdDirectory := ExcludeTrailingPathDelimiter(AValue);
359 end;
360
361 procedure TCustomIBLocalDBSupport.SetupFirebirdEnv;
362 var sdd: string;
363 begin
364 if sysutils.GetEnvironmentVariable('FIREBIRD') = '' then
365 begin
366 if FirebirdDirectory <> '' then
367 begin
368 if not TUpgradeConfFile.IsAbsolutePath(FirebirdDirectory) then
369 FirebirdDirectory := SharedDataDir + FirebirdDirectory;
370 if FileExists(FirebirdDirectory + DirectorySeparator + 'firebird.conf') then
371 begin
372 SetEnvironmentVariable('FIREBIRD',PChar(FirebirdDirectory));
373 Exit;
374 end;
375 end;
376 if FileExists(SharedDataDir + 'firebird.conf') then
377 begin
378 sdd := SharedDataDir;
379 SetEnvironmentVariable('FIREBIRD',PChar(sdd));
380 end;
381 end;
382 end;
383
384 procedure TCustomIBLocalDBSupport.UpgradeCheck;
385 begin
386 if not UpdateVersionNo then
387 Exit;
388
389 if (CurrentDBVersionNo > RequiredVersionNo) and (iblAllowDowngrade in FOptions)then
390 {Possible recovery after failed upgrade}
391 PerformDowngrade(RequiredVersionNo)
392 else
393 if (CurrentDBVersionNo < RequiredVersionNo) and (iblAutoUpgrade in FOptions) then
394 PerformUpgrade(RequiredVersionNo);
395 end;
396
397 procedure TCustomIBLocalDBSupport.SaveEvents;
398 begin
399 FSavedAfterConnect := Database.AfterConnect;
400 Database.AfterConnect := nil;
401 FSavedAfterDisconnect := Database.AfterDisconnect;
402 Database.AfterDisconnect := nil;
403 FSavedBeforeConnect := Database.BeforeConnect;
404 Database.BeforeConnect := nil;
405 FSavedBeforeDisconnect := Database.BeforeDisconnect;
406 Database.BeforeDisconnect := nil;
407 end;
408
409 procedure TCustomIBLocalDBSupport.RestoreEvents;
410 begin
411 Database.AfterConnect := FSavedAfterConnect;
412 Database.AfterDisconnect := FSavedAfterDisconnect;
413 Database.BeforeConnect := FSavedBeforeConnect;
414 Database.BeforeDisconnect := FSavedBeforeDisconnect;
415 end;
416
417 function TCustomIBLocalDBSupport.AllowInitialisation: boolean;
418 begin
419 Result := true;
420 end;
421
422 function TCustomIBLocalDBSupport.AllowRestore: boolean;
423 begin
424 Result := true;
425 end;
426
427 procedure TCustomIBLocalDBSupport.CreateDir(DirName: string);
428 var ParentDirName: string;
429 begin
430 ParentDirName := ExtractFileDir(DirName);
431 if not DirectoryExists(ParentDirName) and (ParentDirName <> DirName) then
432 CreateDir(ParentDirName);
433 if not DirectoryExists(DirName) then
434 mkdir(DirName);
435 end;
436
437 function TCustomIBLocalDBSupport.CreateNewDatabase(DBName: string;
438 DBParams: TStrings; DBArchive: string): boolean;
439 begin
440 Result := false;
441 if FInCreateNew then Exit;
442 FInCreateNew := true;
443 try
444 Result := InternalCreateNewDatabase(DBName,DBParams,DBArchive);
445 finally
446 FInCreateNew := false;
447 end;
448 end;
449
450 procedure TCustomIBLocalDBSupport.Downgrade(DBArchive: string);
451 begin
452 FDownGradeArchive := DBArchive;
453 end;
454
455 procedure TCustomIBLocalDBSupport.DowngradeDone;
456 begin
457 FDownGradeArchive := '';
458 UpdateVersionNo;
459 end;
460
461 function TCustomIBLocalDBSupport.GetDBNameAndPath: string;
462 begin
463 Result := DatabaseName;
464 if VendorName <> '' then
465 Result := VendorName + DirectorySeparator + Result
466 else
467 if Sysutils.VendorName <> '' then
468 Result := SysUtils.VendorName + DirectorySeparator + Result;
469 {$IFDEF UNIX}
470 Result := GetUserDir + '.' + Result;
471 {$ENDIF}
472 {$IFDEF WINDOWS}
473 Result := GetWindowsSpecialDir(CSIDL_LOCAL_APPDATA) + Result;
474 {$ENDIF}
475 if assigned(OnGetDatabaseName) then
476 OnGetDatabaseName(self,Result);
477 end;
478
479 procedure TCustomIBLocalDBSupport.PrepareDBParams(DBParams: TStrings);
480
481 procedure Remove(s: string);
482 var i: integer;
483 begin
484 i := DBParams.IndexOfName(s);
485 if i <> -1 then
486 DBParams.Delete(i);
487 end;
488
489 begin
490 Remove('user_name');
491 Remove('password');
492 {$IFDEF WINDOWS}
493 DBParams.Values['user_name'] := 'SYSDBA';
494 DBParams.Values['password'] := 'masterkey';
495 {$ENDIF}
496 end;
497
498 procedure TCustomIBLocalDBSupport.SetDatabaseName(AValue: string);
499 begin
500 if FDatabaseName = AValue then Exit;
501 FDatabaseName := ExtractFileName(AValue);
502 end;
503
504 function TCustomIBLocalDBSupport.UpdateVersionNo: boolean;
505 begin
506 Result := assigned(OnGetDBVersionNo);
507 if Result then
508 OnGetDBVersionNo(self,FCurrentDBVersionNo); {Update Version No}
509 end;
510
511 constructor TCustomIBLocalDBSupport.Create(aOwner: TComponent);
512 begin
513 inherited Create(aOwner);
514 FEnabled := true;
515 FIBBase := TIBBase.Create(self);
516 FIBBase.AfterDatabaseConnect := @OnDatabaseConnect;
517 FIBBase.BeforeDatabaseConnect := @OnBeforeDatabaseConnect;
518 FIBBase.AfterDatabaseDisconnect := @OnAfterDatabaseDisconnect;
519 FUpgradeConfFile := 'upgrade.conf';
520 FOptions := [iblAutoUpgrade, iblAllowDowngrade];
521 end;
522
523 destructor TCustomIBLocalDBSupport.Destroy;
524 begin
525 if assigned(FIBBase) then FreeAndNil(FIBBase);
526 inherited Destroy;
527 end;
528
529 function TCustomIBLocalDBSupport.DowngradePending: boolean;
530 begin
531 Result := FDownGradeArchive <> '';
532 end;
533
534 procedure TCustomIBLocalDBSupport.NewDatabase;
535 var TempDBParams: TStringList;
536 begin
537 CheckEnabled;
538 if not AllowInitialisation then Exit;
539
540 TempDBParams := TStringList.Create;
541 try
542 TempDBParams.Assign(Database.Params);
543 Database.Connected := false;
544 PrepareDBParams(TempDBParams);
545 CreateDatabase(Database.DatabaseName,TempDBParams,true);
546 finally
547 TempDBParams.Free;
548 end;
549 Database.Connected := true;
550 end;
551
552 procedure TCustomIBLocalDBSupport.PerformDowngrade(TargetVersionNo: integer);
553 var DBArchive: string;
554 begin
555 DBArchive := ChangeFileExt(ActiveDatabasePathName,'') +
556 '.' + IntToStr(TargetVersionNo) + '.gbk';
557 if FileExists(DBArchive) then
558 Downgrade(DBArchive)
559 else
560 raise EIBLocalFatalError.CreateFmt(sNoDowngrade,[CurrentDBVersionNo,TargetVersionNo]);
561 end;
562
563 procedure TCustomIBLocalDBSupport.PerformUpgrade(TargetVersionNo: integer);
564
565 function GetUpgradeConfFile: string;
566 begin
567 Result := UpgradeConfFile;
568 if Result = '' then Exit;
569
570 if not TUpgradeConfFile.IsAbsolutePath(Result) then
571 Result := SharedDataDir + Result;
572 end;
573
574 begin
575 if FInUpgrade then Exit;
576
577 FUpgradeConf := TUpgradeConfFile.Create(GetUpgradeConfFile);
578 try
579 FUpgradeConf.CheckUpgradeAvailable(TargetVersionNo);
580 FInUpgrade := true;
581 try
582 RunUpgradeDatabase(TargetVersionNo);
583 finally
584 FInUpgrade := false;
585 end;
586 finally
587 FreeAndNil(FUpgradeConf);
588 end;
589 end;
590
591 procedure TCustomIBLocalDBSupport.InitDatabaseParameters(DBParams: TStrings;
592 var DBName: string);
593 begin
594 PrepareDBParams(DBParams);
595 DBName := GetDBNameAndPath;
596 if not FileExists(DBName) then
597 CreateDatabase(DBName,DBParams,false);
598 end;
599
600 procedure TCustomIBLocalDBSupport.Loaded;
601 begin
602 inherited Loaded;
603 if (Database <> nil) and (Database.DatabaseName = '') then
604 Database.DatabaseName := ' '; {Avoid CheckDatabaseName Error}
605 DoDirSeparators(FEmptyDBArchive);
606 DoDirSeparators(FFirebirdDirectory);
607 DoDirSeparators(FUpgradeConfFile);
608 end;
609
610 procedure TCustomIBLocalDBSupport.RestoreDatabase(filename: string);
611 var TempDBParams: TStringList;
612 begin
613 CheckEnabled;
614 if not AllowRestore then Exit;
615
616 TempDBParams := TStringList.Create;
617 try
618 TempDBParams.Assign(Database.Params);
619 PrepareDBParams(TempDBParams);
620 Database.Connected := false;
621 RestoreDatabaseFromArchive(Database.DatabaseName,TempDBParams,filename);
622 finally
623 TempDBParams.Free;
624 end;
625 Database.Connected := true;
626 end;
627
628 procedure TCustomIBLocalDBSupport.SaveDatabase(filename: string);
629 var TempDBParams: TStringList;
630 begin
631 CheckEnabled;
632 TempDBParams := TStringList.Create;
633 try
634 TempDBParams.Assign(Database.Params);
635 PrepareDBParams(TempDBParams);
636 SaveDatabaseToArchive(Database.DatabaseName,TempDBParams,filename);
637 finally
638 TempDBParams.Free;
639 end;
640 end;
641
642 end.