ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/iblocaldb/nongui/IBXCustomIBLocalDBSupport.pas
(Generate patch)

Comparing ibx/trunk/iblocaldb/nongui/IBXCustomIBLocalDBSupport.pas (file contents):
Revision 209 by tony, Wed Mar 14 12:48:51 2018 UTC vs.
Revision 272 by tony, Mon Feb 4 13:34:37 2019 UTC

# Line 111 | Line 111 | type
111      FDownGradeArchive: string;
112      FSharedDataDir: string;
113      FUpgradeConf: TUpgradeConfFile;
114 +    FInOnCreateDB: boolean;
115      procedure CheckEnabled;
116      function GetDatabase: TIBDatabase;
117      function GetSharedDataDir: string;
# Line 173 | Line 174 | type
174  
175      property ActiveDatabasePathName: string read FActiveDatabasePathName;
176      property CurrentDBVersionNo: integer read FCurrentDBVersionNo;
177 +    property InOnCreateDB: boolean read FInOnCreateDB;
178      property SharedDataDir: string read GetSharedDataDir;
179      property ServicesConnection: TIBXServicesConnection read FServicesConnection;
180  
# Line 282 | Line 284 | end;
284   procedure TCustomIBLocalDBSupport.OnBeforeDatabaseConnect(Sender: TObject;
285    DBParams: TStrings; var DBName: string; var CreateIfNotExists: boolean);
286   begin
287 <  if not Enabled or (csDesigning in ComponentState) then Exit;
287 >  if FInOnCreateDB or not Enabled or (csDesigning in ComponentState) then Exit;
288  
289 <  if not FirebirdAPI.IsEmbeddedServer then
289 >  if not assigned(Database) or not Database.FirebirdAPI.IsEmbeddedServer then
290       raise EIBLocalFatalError.Create(sNoEmbeddedServer);
291  
292    DBName := GetDBNameAndPath;
# Line 297 | Line 299 | end;
299  
300   procedure TCustomIBLocalDBSupport.OnDatabaseConnected(Sender: TObject);
301   begin
302 +  if FInOnCreateDB then Exit;
303    if not Enabled or (csDesigning in ComponentState) or
304        FInUpgrade then Exit; {Avoids problem if RECONNECT used in script}
305  
# Line 315 | Line 318 | end;
318   procedure TCustomIBLocalDBSupport.OnCreateDatabase(Sender: TObject);
319   var DBArchive: string;
320   begin
321 < CheckEnabled;
319 < DBArchive := EmptyDBArchive;
320 < if DBArchive = '' then
321 <   raise EIBLocalException.Create(sEmptyDBArchiveMissing);
321 > if FInOnCreateDB then Exit;
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]);
328 <
329 < ServicesConnection.ConnectUsing(Database);
323 > FInOnCreateDB := true;
324   try
325 <   if not InternalCreateNewDatabase(DBArchive) then
326 <   begin
327 <     Database.DropDatabase;
328 <     raise EIBLocalException.Create(sCreateFailed);
325 >   CheckEnabled;
326 >   DBArchive := EmptyDBArchive;
327 >   if DBArchive = '' then
328 >     raise EIBLocalException.Create(sEmptyDBArchiveMissing);
329 >
330 >   if not TUpgradeConfFile.IsAbsolutePath(DBArchive) then
331 >     DBArchive := SharedDataDir + DBArchive;
332 >
333 >   if not FileExists(DBArchive) then
334 >     raise EIBLocalException.CreateFmt(sEmptyDBArchiveNotFound,[DBArchive]);
335 >
336 >   ServicesConnection.ConnectUsing(Database);
337 >   try
338 >     if not InternalCreateNewDatabase(DBArchive) then
339 >     begin
340 >       Database.DropDatabase;
341 >       raise EIBLocalException.Create(sCreateFailed);
342 >     end;
343 >   finally
344 >     ServicesConnection.Connected := false;
345     end;
346 +   FNewDBCreated := true;
347   finally
348 <   ServicesConnection.Connected := false;
348 >   FInOnCreateDB := false;
349   end;
339 – FNewDBCreated := true;
350   end;
351  
352   procedure TCustomIBLocalDBSupport.SetFirebirdDirectory(AValue: string);

Diff Legend

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