ViewVC Help

View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing

root/public/ibx/trunk/examples/services/ShutdownDatabaseDlgUnit.pas

Comparing ibx/trunk/examples/services/ShutdownDatabaseDlgUnit.pas (file contents):
Revision 208 by tony, Fri Feb 23 12:11:21 2018 UTC vs.
Revision 209 by tony, Wed Mar 14 12:48:51 2018 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.

Diff Legend

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