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

Comparing ibx/trunk/examples/services/ShutdownDatabaseDlgUnit.pas (file contents):
Revision 143 by tony, Fri Feb 23 12:11:21 2018 UTC vs.
Revision 380 by tony, Mon Jan 10 10:13:17 2022 UTC

# Line 32 | Line 32 | interface
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  
# Line 41 | Line 41 | type
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(aShutDownmode: TShutdownMode; aDelay: integer);
57 >     procedure Shutdown(aDBName: string; aShutDownmode: TDBShutdownMode; aDelay: integer);
58       property Aborting: boolean read FAborting;
59    end;
60  
# Line 65 | Line 65 | implementation
65  
66   {$R *.lfm}
67  
68 – uses IBErrorCodes;
69 –
68   resourcestring
69    sWaitStatusMsg = 'Waiting for %s to shutdown';
70    sDatabaseShutdown  = 'Database has been successfully shutdown';
# Line 78 | Line 76 | type
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;
# Line 88 | Line 86 | type
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;
# Line 110 | Line 108 | end;
108   procedure TShutdownWaitThread.Execute;
109   begin
110    FSuccess := false;
113 –  FIBConfigService.Active := true;
111    try
112      try
113        FIBConfigService.ShutDownDatabase(FOptions,FWait);
114        FErrorMessage := 'Completed without error';
115        FSuccess := true;
116      except
120 –      on E: EIBInterBaseError do
121 –        if E.IBErrorCode = isc_sec_context then
122 –          FSecContextError := true
123 –        else
124 –          FErrorMessage := E.Message;
125 –
117        on E: Exception do
118          FErrorMessage := E.Message;
119      end;
120    finally
130 –    if not FSecContextError then
131 –      while FIBConfigService.IsServiceRunning do;
121      if Terminated and FSuccess then
122        FIBConfigService.BringDatabaseOnline;
134 –    FIBConfigService.Active := false;
123    end;
124    Synchronize(@DoCallback);
125   end;
126  
127 < constructor TShutdownWaitThread.Create(aService: TIBConfigService;
128 <  Options: TShutdownMode; Wait: Integer; OnCompleted: TNotifyEvent);
141 < var Password: string;
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  
# Line 180 | Line 167 | end;
167   procedure TShutdownDatabaseDlg.OnWaitCompleted(Sender: TObject);
168   begin
169    with TShutdownWaitThread(Sender) do
183 –    if not Success and SecContextError then
184 –      self.FSecContextError := true
185 –    else
170      if not FAborting then
171        MessageDlg(Format(sOnCompleted,[IBConfigService.DatabaseName,ErrorMessage]),
172                 mtInformation,[mbOK],0);
# Line 190 | Line 174 | begin
174    Close;
175   end;
176  
177 < procedure TShutdownDatabaseDlg.Shutdown(aShutDownmode: TShutdownMode; aDelay: integer);
177 > procedure TShutdownDatabaseDlg.Shutdown(aDBName: string;
178 >  aShutDownmode: TDBShutdownMode; aDelay: integer);
179   begin
180 +  IBConfigService.DatabaseName := aDBName;
181    FShutDownmode := aShutDownmode;
182    FDelay := aDelay;
183    FSecContextError := false;
184    if aDelay <= 0 then
185    begin
200 –    IBConfigService.Active := true;
201 –    try
186        IBConfigService.ShutDownDatabase(aShutDownmode,0);
187 <      while IBConfigService.IsServiceRunning do;
204 <      if aDelay = 0 then
205 <        MessageDlg(sDatabaseShutdown,mtInformation,[mbOK],0);
206 <    finally
207 <      IBConfigService.Active := false;
208 <    end
187 >      MessageDlg(sDatabaseShutdown,mtInformation,[mbOK],0);
188    end
189    else
211 –  begin
190      ShowModal;
213 –    if FSecContextError  then
214 –      raise EIBInterBaseError.Create(FirebirdAPI.getStatus); {re-raise the error}
215 –  end;
191   end;
192  
193   end.

Comparing ibx/trunk/examples/services/ShutdownDatabaseDlgUnit.pas (property svn:eol-style):
Revision 143 by tony, Fri Feb 23 12:11:21 2018 UTC vs.
Revision 380 by tony, Mon Jan 10 10:13:17 2022 UTC

# Line 0 | Line 1
1 + native

Diff Legend

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