ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/iblocaldb/IBXCustomIBLocalDBSupport.pas
Revision: 37
Committed: Mon Feb 15 14:44:25 2016 UTC (8 years, 1 month ago) by tony
Content type: text/x-pascal
File size: 21406 byte(s)
Log Message:
Committing updates for Release R1-4-0

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