| 1 |
|
(* |
| 2 |
< |
* ShutdownDatabaseDlgUnit.pas |
| 3 |
< |
* Copyright (C) 2018 Tony Whyman <tony@mwasoftware.co.uk> |
| 2 |
> |
* IBX For Lazarus (Firebird Express) |
| 3 |
|
* |
| 4 |
< |
* DBAdmin is free software: you can redistribute it and/or modify it |
| 5 |
< |
* under the terms of the GNU General Public License as published by the |
| 6 |
< |
* Free Software Foundation, either version 3 of the License, or |
| 7 |
< |
* (at your option) any later version. |
| 8 |
< |
* |
| 9 |
< |
* DBAdmin is distributed in the hope that it will be useful, but |
| 10 |
< |
* WITHOUT ANY WARRANTY; without even the implied warranty of |
| 11 |
< |
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. |
| 12 |
< |
* See the GNU General Public License for more details. |
| 13 |
< |
* |
| 14 |
< |
* You should have received a copy of the GNU General Public License along |
| 15 |
< |
* with this program. If not, see <http://www.gnu.org/licenses/>. |
| 16 |
< |
*) |
| 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) 2015 Tony Whyman, MWA Software |
| 19 |
> |
* (http://www.mwasoftware.co.uk). |
| 20 |
> |
* |
| 21 |
> |
* All Rights Reserved. |
| 22 |
> |
* |
| 23 |
> |
* Contributor(s): ______________________________________. |
| 24 |
> |
* |
| 25 |
> |
*) |
| 26 |
> |
|
| 27 |
|
unit ShutdownDatabaseDlgUnit; |
| 28 |
|
|
| 29 |
|
{$mode objfpc}{$H+} |
| 32 |
|
|
| 33 |
|
uses |
| 34 |
|
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, |
| 35 |
< |
ComCtrls, ExtCtrls, IBServices, IB; |
| 35 |
> |
ComCtrls, ExtCtrls, IBXServices, IB; |
| 36 |
|
|
| 37 |
|
type |
| 38 |
|
|
| 41 |
|
TShutdownDatabaseDlg = class(TForm) |
| 42 |
|
Bevel1: TBevel; |
| 43 |
|
CloseBtn: TButton; |
| 44 |
< |
IBConfigService: TIBConfigService; |
| 44 |
> |
IBConfigService: TIBXConfigService; |
| 45 |
|
ProgressBar1: TProgressBar; |
| 46 |
|
StatusMsg: TLabel; |
| 47 |
|
procedure CloseBtnClick(Sender: TObject); |
| 48 |
|
procedure FormShow(Sender: TObject); |
| 49 |
|
private |
| 50 |
< |
FShutDownmode: TShutdownMode; |
| 50 |
> |
FShutDownmode: TDBShutdownMode; |
| 51 |
|
FDelay: integer; |
| 52 |
|
FAborting: boolean; |
| 53 |
|
FSecContextError: boolean; |
| 54 |
|
FShutdownWaitThread: TThread; |
| 55 |
|
procedure OnWaitCompleted(Sender: TObject); |
| 56 |
|
public |
| 57 |
< |
procedure Shutdown(aService: TIBConfigService; aShutDownmode: TShutdownMode; |
| 49 |
< |
aDelay: integer); |
| 57 |
> |
procedure Shutdown(aDBName: string; aShutDownmode: TDBShutdownMode; aDelay: integer); |
| 58 |
|
property Aborting: boolean read FAborting; |
| 59 |
|
end; |
| 60 |
|
|
| 65 |
|
|
| 66 |
|
{$R *.lfm} |
| 67 |
|
|
| 60 |
– |
uses IBErrorCodes; |
| 61 |
– |
|
| 68 |
|
resourcestring |
| 69 |
|
sWaitStatusMsg = 'Waiting for %s to shutdown'; |
| 70 |
|
sDatabaseShutdown = 'Database has been successfully shutdown'; |
| 76 |
|
TShutdownWaitThread = class(TThread) |
| 77 |
|
private |
| 78 |
|
FErrorMessage: string; |
| 79 |
< |
FIBConfigService: TIBConfigService; |
| 80 |
< |
FOptions: TShutdownMode; |
| 79 |
> |
FIBConfigService: TIBXConfigService; |
| 80 |
> |
FOptions: TDBShutdownMode; |
| 81 |
|
FSecContextError: boolean; |
| 82 |
|
FSuccess: boolean; |
| 83 |
|
FWait: integer; |
| 86 |
|
protected |
| 87 |
|
procedure Execute; override; |
| 88 |
|
public |
| 89 |
< |
constructor Create(aService: TIBConfigService; Options: TShutdownMode; |
| 89 |
> |
constructor Create(aService: TIBXConfigService; Options: TDBShutdownMode; |
| 90 |
|
Wait: Integer; OnCompleted: TNotifyEvent); |
| 91 |
|
destructor Destroy; override; |
| 92 |
|
procedure Abort; |
| 108 |
|
procedure TShutdownWaitThread.Execute; |
| 109 |
|
begin |
| 110 |
|
FSuccess := false; |
| 105 |
– |
FIBConfigService.Active := true; |
| 111 |
|
try |
| 112 |
|
try |
| 113 |
|
FIBConfigService.ShutDownDatabase(FOptions,FWait); |
| 114 |
|
FErrorMessage := 'Completed without error'; |
| 115 |
|
FSuccess := true; |
| 116 |
|
except |
| 112 |
– |
on E: EIBInterBaseError do |
| 113 |
– |
if E.IBErrorCode = isc_sec_context then |
| 114 |
– |
FSecContextError := true |
| 115 |
– |
else |
| 116 |
– |
FErrorMessage := E.Message; |
| 117 |
– |
|
| 117 |
|
on E: Exception do |
| 118 |
|
FErrorMessage := E.Message; |
| 119 |
|
end; |
| 120 |
|
finally |
| 122 |
– |
if not FSecContextError then |
| 123 |
– |
try |
| 124 |
– |
while FIBConfigService.IsServiceRunning do; |
| 125 |
– |
except end; |
| 121 |
|
if Terminated and FSuccess then |
| 122 |
|
FIBConfigService.BringDatabaseOnline; |
| 128 |
– |
FIBConfigService.Active := false; |
| 123 |
|
end; |
| 124 |
|
Synchronize(@DoCallback); |
| 125 |
|
end; |
| 126 |
|
|
| 127 |
< |
constructor TShutdownWaitThread.Create(aService: TIBConfigService; |
| 128 |
< |
Options: TShutdownMode; Wait: Integer; OnCompleted: TNotifyEvent); |
| 127 |
> |
constructor TShutdownWaitThread.Create(aService: TIBXConfigService; |
| 128 |
> |
Options: TDBShutdownMode; Wait: Integer; OnCompleted: TNotifyEvent); |
| 129 |
|
begin |
| 130 |
|
inherited Create(false); |
| 131 |
|
FOptions := Options; |
| 132 |
|
FWait := Wait; |
| 133 |
|
FOnCompleted := OnCompleted; |
| 134 |
|
FreeOnTerminate := true; |
| 135 |
< |
FIBConfigService := TIBConfigService.Create(nil); |
| 136 |
< |
FIBConfigService.Assign(aService); |
| 135 |
> |
FIBConfigService := TIBXConfigService.Create(nil); |
| 136 |
> |
FIBConfigService.ServicesConnection := aService.ServicesConnection; |
| 137 |
|
FIBConfigService.DatabaseName := aService.DatabaseNAme; |
| 138 |
|
end; |
| 139 |
|
|
| 167 |
|
procedure TShutdownDatabaseDlg.OnWaitCompleted(Sender: TObject); |
| 168 |
|
begin |
| 169 |
|
with TShutdownWaitThread(Sender) do |
| 176 |
– |
if not Success and SecContextError then |
| 177 |
– |
self.FSecContextError := true |
| 178 |
– |
else |
| 170 |
|
if not FAborting then |
| 171 |
|
MessageDlg(Format(sOnCompleted,[IBConfigService.DatabaseName,ErrorMessage]), |
| 172 |
|
mtInformation,[mbOK],0); |
| 174 |
|
Close; |
| 175 |
|
end; |
| 176 |
|
|
| 177 |
< |
procedure TShutdownDatabaseDlg.Shutdown(aService: TIBConfigService; |
| 178 |
< |
aShutDownmode: TShutdownMode; aDelay: integer); |
| 177 |
> |
procedure TShutdownDatabaseDlg.Shutdown(aDBName: string; |
| 178 |
> |
aShutDownmode: TDBShutdownMode; aDelay: integer); |
| 179 |
|
begin |
| 180 |
< |
IBConfigService.Assign(aService); |
| 190 |
< |
IBConfigService.DatabaseName := aService.DatabaseName; |
| 180 |
> |
IBConfigService.DatabaseName := aDBName; |
| 181 |
|
FShutDownmode := aShutDownmode; |
| 182 |
|
FDelay := aDelay; |
| 183 |
|
FSecContextError := false; |
| 184 |
|
if aDelay <= 0 then |
| 185 |
|
begin |
| 196 |
– |
IBConfigService.Active := true; |
| 197 |
– |
try |
| 186 |
|
IBConfigService.ShutDownDatabase(aShutDownmode,0); |
| 187 |
< |
while IBConfigService.IsServiceRunning do; |
| 200 |
< |
if aDelay = 0 then |
| 201 |
< |
MessageDlg(sDatabaseShutdown,mtInformation,[mbOK],0); |
| 202 |
< |
finally |
| 203 |
< |
IBConfigService.Active := false; |
| 204 |
< |
end |
| 187 |
> |
MessageDlg(sDatabaseShutdown,mtInformation,[mbOK],0); |
| 188 |
|
end |
| 189 |
|
else |
| 207 |
– |
begin |
| 190 |
|
ShowModal; |
| 209 |
– |
if FSecContextError then |
| 210 |
– |
raise EIBInterBaseError.Create(FirebirdAPI.getStatus); {re-raise the error} |
| 211 |
– |
end; |
| 191 |
|
end; |
| 192 |
|
|
| 193 |
|
end. |
