examples/services/MainFormUnit.pas

(*
 *  IBX For Lazarus (Firebird Express)
 *
 *  The contents of this file are subject to the Initial Developer's
 *  Public License Version 1.0 (the "License"); you may not use this
 *  file except in compliance with the License. You may obtain a copy
 *  of the License here:
 *
 *    http://www.firebirdsql.org/index.php?op=doc&id=idpl
 *
 *  Software distributed under the License is distributed on an "AS
 *  IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
 *  implied. See the License for the specific language governing rights
 *  and limitations under the License.
 *
 *  The Initial Developer of the Original Code is Tony Whyman.
 *
 *  The Original Code is (C) 2015 Tony Whyman, MWA Software
 *  (http://www.mwasoftware.co.uk).
 *
 *  All Rights Reserved.
 *
 *  Contributor(s): ______________________________________.
 *
*) 
            
unit MainFormUnit;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  ActnList, Menus, IBXServices, IB;

const
  sDefaultDatabaseName = 'employee';

type

  TRunServiceProc = procedure of object;

  { TMainForm }

  TMainForm = class(TForm)
    IBConfigService1: TIBXConfigService;
    IBXServicesConnection1: TIBXServicesConnection;
    MenuItem6: TMenuItem;
    Shutdown: TAction;
    BringOnline: TAction;
    MenuItem1: TMenuItem;
    MenuItem5: TMenuItem;
    Sweep: TAction;
    LimboTransactions: TAction;
    MenuItem2: TMenuItem;
    MenuItem3: TMenuItem;
    MenuItem4: TMenuItem;
    PopupMenu1: TPopupMenu;
    Validate: TAction;
    Statistics: TAction;
    ActionList1: TActionList;
    CLoseBtn: TButton;
    BackupBtn: TButton;
    RestoreBtn: TButton;
    ServerLOgBtn: TButton;
    DatabaseBtn: TButton;
    UsersBtn: TButton;
    IBLogService1: TIBXLogService;
    IBOnlineValidationService1: TIBXOnlineValidationService;
    IBServerProperties1: TIBXServerProperties;
    IBStatisticalService1: TIBXStatisticalService;
    IBValidationService1: TIBXValidationService;
    Memo1: TMemo;
    procedure BringOnlineExecute(Sender: TObject);
    procedure BringOnlineUpdate(Sender: TObject);
    procedure CLoseBtnClick(Sender: TObject);
    procedure BackupBtnClick(Sender: TObject);
    procedure IBXServicesConnection1Login(Service: TIBXServicesConnection;
      var aServerName: string; LoginParams: TStrings);
    procedure IBXServicesConnection1SecurityContextException(
      Service: TIBXServicesConnection; var aAction: TSecContextAction);
    procedure RestoreBtnClick(Sender: TObject);
    procedure ServerLOgBtnClick(Sender: TObject);
    procedure DatabaseBtnClick(Sender: TObject);
    procedure ShutdownExecute(Sender: TObject);
    procedure SweepExecute(Sender: TObject);
    procedure UsersBtnClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure LimboTransactionsExecute(Sender: TObject);
    procedure StatisticsExecute(Sender: TObject);
    procedure ValidateExecute(Sender: TObject);
  private
    { private declarations }
    FDBName: string;
    FServerUserName: string;
    FServerPassword: string;
    FShutDownMode: TDBShutdownMode;
    FDelay: integer;
    procedure SetDBName(AValue: string);
    property DBName: string read FDBName write SetDBName;
  public
    { public declarations }
    function IsDatabaseOnline: boolean;
  end;

var
  MainForm: TMainForm;

implementation

{$R *.lfm}

uses FBMessages, ServicesLoginDlgUnit, SelectValidationDlgUnit, SelectDBDlgUnit,
  BackupDlgUnit, RestoreDlgUnit,  ListUsersUnit, LimboTransactionsUnit,
  ShutdownDatabaseDlgUnit, ShutdownRegDlgUnit;

resourcestring
  sDBSweep     = 'Database sweep started';
  sSweepOK     = 'Sweep successfully completed';
  sSecContext  = 'This database appears to use an alternative security database. '+
                 'You must now log into the alternative security database using login '+
                 'credentials for the alternative security database.';


{ TMainForm }

procedure TMainForm.FormShow(Sender: TObject);
var i: integer;
begin
  {Set IB Exceptions to only show text message - omit SQLCode and Engine Code}
  FirebirdAPI.GetStatus.SetIBDataBaseErrorMessages([ShowIBMessage]);
  Application.ExceptionDialog := aedOkMessageBox;
  FDBName := sDefaultDatabaseName;

  {Open the Services API connection }
  with IBXServicesConnection1 do
  begin
    while not Connected do
    begin
      try
        Connected := true;
      except
       on E:EIBClientError do
        begin
          Close;
          Exit
        end;
       On E:Exception do
         MessageDlg(E.Message,mtError,[mbOK],0);
      end;
    end; {Loop until logged in or user cancels}
  end;

  {Now display the server properties}
  with IBServerProperties1, ServicesConnection do
  begin
    Memo1.Lines.Add('Server Version = ' + VersionInfo.ServerVersion);
    Memo1.Lines.Add('Server Implementation = ' + VersionInfo.ServerImplementation);
    Memo1.Lines.Add('Service Version = ' + IntToStr(VersionInfo.ServiceVersion));
    Memo1.Lines.Add(Format('Firebird Release = %d.%d.%d (Build no. %d)',[ServerVersionNo[1],
                                                             ServerVersionNo[2],
                                                             ServerVersionNo[3],
                                                             ServerVersionNo[4]]));
    Memo1.Lines.Add('No. of attachments = ' + IntToStr(DatabaseInfo.NoOfAttachments));
    Memo1.Lines.Add('No. of databases = ' + IntToStr(DatabaseInfo.NoOfDatabases));
    for i := 0 to DatabaseInfo.NoOfDatabases - 1 do
      Memo1.Lines.Add('DB Name = ' + DatabaseInfo.DbName[i]);
    Memo1.Lines.Add('Base Location = ' + ConfigParams.BaseLocation);
    Memo1.Lines.Add('Lock File Location = ' + ConfigParams.LockFileLocation);
    Memo1.Lines.Add('Security Database Location = ' + ConfigParams.SecurityDatabaseLocation);
    Memo1.Lines.Add('Message File Location = ' + ConfigParams.MessageFileLocation);
    for i := Low(ConfigParams.ConfigFileParams) to High(ConfigParams.ConfigFileParams) do
      Memo1.Lines.Add(ConfigParams.ConfigFileParams[i]);
    for i := Low(ConfigParams.ConfigFileData.ConfigFileKey) to High(ConfigParams.ConfigFileData.ConfigFileKey) do
      Memo1.Lines.Add(Format('%d=%s',[ConfigParams.ConfigFileData.ConfigFileKey[i],ConfigParams.ConfigFileData.ConfigFileValue[i]]));
  end;
end;


procedure TMainForm.LimboTransactionsExecute(Sender: TObject);
var aDBName: string;
begin
  aDBName := DBName;
  with LimboTransactionsForm do
  begin
    if SelectDBDlg.ShowModal(aDBName) = mrOK then
    begin
      DBName := aDBName;
      IBXLimboTransactionResolutionService1.DatabaseName := DBName;
      ShowModal;
    end;
  end;
end;

procedure TMainForm.StatisticsExecute(Sender: TObject);
var aDBName: string;
begin
  aDBName := DBName;
  if SelectDBDlg.ShowModal(aDBName) = mrOK then
  begin
    DBName := aDBName;
    IBStatisticalService1.Options := [DataPages];
    IBStatisticalService1.DatabaseName := DBName;
    Memo1.Lines.Add('Database Statistics for ' + IBStatisticalService1.DatabaseName);
    IBStatisticalService1.Execute(Memo1.Lines);
  end;
end;

procedure TMainForm.ValidateExecute(Sender: TObject);
var UseOnlineValidation: boolean;
    aDBName: string;
begin
  UseOnlineValidation := false;
  aDBName := DBName;
  if SelectValidationDlg.ShowModal(IBXServicesConnection1.ServerName,aDBName,UseOnlineValidation) = mrOK then
  begin
    DBName := aDBName;
    Memo1.Lines.Add('Running...');
    if UseOnlineValidation then
    begin
      IBOnlineValidationService1.DatabaseName := DBName;
      IBOnlineValidationService1.Execute(Memo1.Lines);
    end
    else
    begin
      IBValidationService1.Options := [ValidateFull];
      IBValidationService1.DatabaseName := DBName;
      IBValidationService1.Execute(Memo1.Lines);
    end;
    Memo1.Lines.Add('Validation Completed');
    MessageDlg('Validation Completed',mtInformation,[mbOK],0);
  end;
end;

procedure TMainForm.SetDBName(AValue: string);
begin
  if FDBName = AValue then Exit;
  FDBName := AValue;
end;

function TMainForm.IsDatabaseOnline: boolean;
var Lines: TStringList;
    i: integer;
    line: string;
begin
  {Scan header page to see if database is online - assumes that service is already set up}
  Result := true;
  with IBStatisticalService1 do
  begin
    Options := [HeaderPages];
    DatabaseName := DBName;
    Lines := TStringList.Create;
    try
      Execute(Lines);
      for i := 0 to Lines.Count - 1 do
      begin
        line := Lines[i];
         if (Pos('Attributes',Line) <> 0) and ((Pos('database shutdown',Line) <> 0)
                   or (Pos('multi-user maintenance',Line) <> 0)) then
         begin
           Result := false;
           break;
         end;

      end;
    finally
      Lines.Free;
    end
  end;
end;

procedure TMainForm.CLoseBtnClick(Sender: TObject);
begin
  Close
end;

procedure TMainForm.BringOnlineExecute(Sender: TObject);
var aDBName: string;
begin
  aDBName := DBName;
  if SelectDBDlg.ShowModal(aDBName) = mrOK then
  begin
    DBName := aDBName;
    if IsDatabaseOnline then
      MessageDlg('Database is already online!',mtInformation,[mbOK],0)
    else
    begin
      IBConfigService1.DatabaseName := DBName;
      IBConfigService1.BringDatabaseOnline;
      if IsDatabaseOnline then
        MessageDlg('Database is back online',mtInformation,[mbOK],0)
      else
        MessageDlg('Database is still shutdown!',mtError,[mbOK],0);
    end;
  end;
end;

procedure TMainForm.BringOnlineUpdate(Sender: TObject);
begin
  (Sender as TAction).Enabled := not ShutdownDatabaseDlg.Aborting;
end;

procedure TMainForm.BackupBtnClick(Sender: TObject);
var aDBName: string;
begin
  aDBName := DBName;
  if BackupDlg.ShowModal(aDBName,Memo1.Lines) = mrOK then
    DBName := aDBName;
end;

{Logon to the current security database on the server}

procedure TMainForm.IBXServicesConnection1Login(
  Service: TIBXServicesConnection; var aServerName: string; LoginParams: TStrings);
var aServiceName: string;
    aUserName: string;
    aPassword: string;
begin
  aServiceName := aServerName;
  aUserName := LoginParams.Values['user_name'];
  aPassword := '';
  if SvcLoginDlg.ShowModal(aServiceName, aUserName, aPassword) = mrOK then
  begin
    Service.ServerName := aServiceName;
    LoginParams.Values['user_name'] := aUserName;
    LoginParams.Values['password'] := aPassword;
    FServerUserName := aUserName;
    FServerPassword := aPassword;
    aServerName := aServiceName;
  end
  else
    IBError(ibxeOperationCancelled, [nil]);
end;

procedure TMainForm.IBXServicesConnection1SecurityContextException(
  Service: TIBXServicesConnection; var aAction: TSecContextAction);
begin
  if MessageDlg(sSecContext,mtInformation,[mbYes,mbNo],0) = mrYes then
    aAction := scReconnect;
end;

procedure TMainForm.RestoreBtnClick(Sender: TObject);
var aDBName: string;
begin
  aDBName := DBName;
  if RestoreDlg.ShowModal(aDBName,Memo1.Lines) = mrOK then
    DBName := aDBName;
end;

procedure TMainForm.ServerLOgBtnClick(Sender: TObject);
begin
  Memo1.Lines.Add('Server Log');
  IBLogService1.Execute(Memo1.Lines);
end;

procedure TMainForm.DatabaseBtnClick(Sender: TObject);
begin
  PopupMenu1.PopUp(Mouse.CursorPos.X,Mouse.CursorPos.Y);
end;

procedure TMainForm.ShutdownExecute(Sender: TObject);
var aDBName: string;
begin
  aDBName := DBName;
  FShutDownMode := DenyTransaction;
  if ShutdownReqDlg.ShowModal(aDBName,FShutDownMode,FDelay) = mrOK then
  begin
    DBName := aDBName;
    if not IsDatabaseOnline then
      MessageDlg('Database is already shutdown!',mtInformation,[mbOK],0)
    else
      ShutdownDatabaseDlg.Shutdown(DBName,FShutDownMode,FDelay);
  end;
end;

procedure TMainForm.SweepExecute(Sender: TObject);
var aDBName: string;
begin
  aDBName := DBName;
  if SelectDBDlg.ShowModal(aDBName) = mrOK then
  with IBValidationService1 do
  begin
    DBName := aDBName;
    DatabaseName := DBName;
    Options := [SweepDB];
    Memo1.Lines.Add(Format(sDBSweep,[DatabaseName]));
    Execute(Memo1.Lines);
    Memo1.Lines.Add(sSweepOK);
  end;
end;

procedure TMainForm.UsersBtnClick(Sender: TObject);
begin
  ListUsersForm.ShowModal;
end;

end.

Revision:	209
Committed:	Wed Mar 14 12:48:51 2018 UTC (6 years, 9 months ago) by tony
Content type:	text/x-pascal
File size:	12147 byte(s)
Log Message:	Fixes Merged
#	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) 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 MainFormUnit;
28
29	{$mode objfpc}{$H+}
30
31	interface
32
33	uses
34	Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
35	ActnList, Menus, IBXServices, IB;
36
37	const
38	sDefaultDatabaseName = 'employee';
39
40	type
41
42	TRunServiceProc = procedure of object;
43
44	{ TMainForm }
45
46	TMainForm = class(TForm)
47	IBConfigService1: TIBXConfigService;
48	IBXServicesConnection1: TIBXServicesConnection;
49	MenuItem6: TMenuItem;
50	Shutdown: TAction;
51	BringOnline: TAction;
52	MenuItem1: TMenuItem;
53	MenuItem5: TMenuItem;
54	Sweep: TAction;
55	LimboTransactions: TAction;
56	MenuItem2: TMenuItem;
57	MenuItem3: TMenuItem;
58	MenuItem4: TMenuItem;
59	PopupMenu1: TPopupMenu;
60	Validate: TAction;
61	Statistics: TAction;
62	ActionList1: TActionList;
63	CLoseBtn: TButton;
64	BackupBtn: TButton;
65	RestoreBtn: TButton;
66	ServerLOgBtn: TButton;
67	DatabaseBtn: TButton;
68	UsersBtn: TButton;
69	IBLogService1: TIBXLogService;
70	IBOnlineValidationService1: TIBXOnlineValidationService;
71	IBServerProperties1: TIBXServerProperties;
72	IBStatisticalService1: TIBXStatisticalService;
73	IBValidationService1: TIBXValidationService;
74	Memo1: TMemo;
75	procedure BringOnlineExecute(Sender: TObject);
76	procedure BringOnlineUpdate(Sender: TObject);
77	procedure CLoseBtnClick(Sender: TObject);
78	procedure BackupBtnClick(Sender: TObject);
79	procedure IBXServicesConnection1Login(Service: TIBXServicesConnection;
80	var aServerName: string; LoginParams: TStrings);
81	procedure IBXServicesConnection1SecurityContextException(
82	Service: TIBXServicesConnection; var aAction: TSecContextAction);
83	procedure RestoreBtnClick(Sender: TObject);
84	procedure ServerLOgBtnClick(Sender: TObject);
85	procedure DatabaseBtnClick(Sender: TObject);
86	procedure ShutdownExecute(Sender: TObject);
87	procedure SweepExecute(Sender: TObject);
88	procedure UsersBtnClick(Sender: TObject);
89	procedure FormShow(Sender: TObject);
90	procedure LimboTransactionsExecute(Sender: TObject);
91	procedure StatisticsExecute(Sender: TObject);
92	procedure ValidateExecute(Sender: TObject);
93	private
94	{ private declarations }
95	FDBName: string;
96	FServerUserName: string;
97	FServerPassword: string;
98	FShutDownMode: TDBShutdownMode;
99	FDelay: integer;
100	procedure SetDBName(AValue: string);
101	property DBName: string read FDBName write SetDBName;
102	public
103	{ public declarations }
104	function IsDatabaseOnline: boolean;
105	end;
106
107	var
108	MainForm: TMainForm;
109
110	implementation
111
112	{$R *.lfm}
113
114	uses FBMessages, ServicesLoginDlgUnit, SelectValidationDlgUnit, SelectDBDlgUnit,
115	BackupDlgUnit, RestoreDlgUnit, ListUsersUnit, LimboTransactionsUnit,
116	ShutdownDatabaseDlgUnit, ShutdownRegDlgUnit;
117
118	resourcestring
119	sDBSweep = 'Database sweep started';
120	sSweepOK = 'Sweep successfully completed';
121	sSecContext = 'This database appears to use an alternative security database. '+
122	'You must now log into the alternative security database using login '+
123	'credentials for the alternative security database.';
124
125
126	{ TMainForm }
127
128	procedure TMainForm.FormShow(Sender: TObject);
129	var i: integer;
130	begin
131	{Set IB Exceptions to only show text message - omit SQLCode and Engine Code}
132	FirebirdAPI.GetStatus.SetIBDataBaseErrorMessages([ShowIBMessage]);
133	Application.ExceptionDialog := aedOkMessageBox;
134	FDBName := sDefaultDatabaseName;
135
136	{Open the Services API connection }
137	with IBXServicesConnection1 do
138	begin
139	while not Connected do
140	begin
141	try
142	Connected := true;
143	except
144	on E:EIBClientError do
145	begin
146	Close;
147	Exit
148	end;
149	On E:Exception do
150	MessageDlg(E.Message,mtError,[mbOK],0);
151	end;
152	end; {Loop until logged in or user cancels}
153	end;
154
155	{Now display the server properties}
156	with IBServerProperties1, ServicesConnection do
157	begin
158	Memo1.Lines.Add('Server Version = ' + VersionInfo.ServerVersion);
159	Memo1.Lines.Add('Server Implementation = ' + VersionInfo.ServerImplementation);
160	Memo1.Lines.Add('Service Version = ' + IntToStr(VersionInfo.ServiceVersion));
161	Memo1.Lines.Add(Format('Firebird Release = %d.%d.%d (Build no. %d)',[ServerVersionNo[1],
162	ServerVersionNo[2],
163	ServerVersionNo[3],
164	ServerVersionNo[4]]));
165	Memo1.Lines.Add('No. of attachments = ' + IntToStr(DatabaseInfo.NoOfAttachments));
166	Memo1.Lines.Add('No. of databases = ' + IntToStr(DatabaseInfo.NoOfDatabases));
167	for i := 0 to DatabaseInfo.NoOfDatabases - 1 do
168	Memo1.Lines.Add('DB Name = ' + DatabaseInfo.DbName[i]);
169	Memo1.Lines.Add('Base Location = ' + ConfigParams.BaseLocation);
170	Memo1.Lines.Add('Lock File Location = ' + ConfigParams.LockFileLocation);
171	Memo1.Lines.Add('Security Database Location = ' + ConfigParams.SecurityDatabaseLocation);
172	Memo1.Lines.Add('Message File Location = ' + ConfigParams.MessageFileLocation);
173	for i := Low(ConfigParams.ConfigFileParams) to High(ConfigParams.ConfigFileParams) do
174	Memo1.Lines.Add(ConfigParams.ConfigFileParams[i]);
175	for i := Low(ConfigParams.ConfigFileData.ConfigFileKey) to High(ConfigParams.ConfigFileData.ConfigFileKey) do
176	Memo1.Lines.Add(Format('%d=%s',[ConfigParams.ConfigFileData.ConfigFileKey[i],ConfigParams.ConfigFileData.ConfigFileValue[i]]));
177	end;
178	end;
179
180
181	procedure TMainForm.LimboTransactionsExecute(Sender: TObject);
182	var aDBName: string;
183	begin
184	aDBName := DBName;
185	with LimboTransactionsForm do
186	begin
187	if SelectDBDlg.ShowModal(aDBName) = mrOK then
188	begin
189	DBName := aDBName;
190	IBXLimboTransactionResolutionService1.DatabaseName := DBName;
191	ShowModal;
192	end;
193	end;
194	end;
195
196	procedure TMainForm.StatisticsExecute(Sender: TObject);
197	var aDBName: string;
198	begin
199	aDBName := DBName;
200	if SelectDBDlg.ShowModal(aDBName) = mrOK then
201	begin
202	DBName := aDBName;
203	IBStatisticalService1.Options := [DataPages];
204	IBStatisticalService1.DatabaseName := DBName;
205	Memo1.Lines.Add('Database Statistics for ' + IBStatisticalService1.DatabaseName);
206	IBStatisticalService1.Execute(Memo1.Lines);
207	end;
208	end;
209
210	procedure TMainForm.ValidateExecute(Sender: TObject);
211	var UseOnlineValidation: boolean;
212	aDBName: string;
213	begin
214	UseOnlineValidation := false;
215	aDBName := DBName;
216	if SelectValidationDlg.ShowModal(IBXServicesConnection1.ServerName,aDBName,UseOnlineValidation) = mrOK then
217	begin
218	DBName := aDBName;
219	Memo1.Lines.Add('Running...');
220	if UseOnlineValidation then
221	begin
222	IBOnlineValidationService1.DatabaseName := DBName;
223	IBOnlineValidationService1.Execute(Memo1.Lines);
224	end
225	else
226	begin
227	IBValidationService1.Options := [ValidateFull];
228	IBValidationService1.DatabaseName := DBName;
229	IBValidationService1.Execute(Memo1.Lines);
230	end;
231	Memo1.Lines.Add('Validation Completed');
232	MessageDlg('Validation Completed',mtInformation,[mbOK],0);
233	end;
234	end;
235
236	procedure TMainForm.SetDBName(AValue: string);
237	begin
238	if FDBName = AValue then Exit;
239	FDBName := AValue;
240	end;
241
242	function TMainForm.IsDatabaseOnline: boolean;
243	var Lines: TStringList;
244	i: integer;
245	line: string;
246	begin
247	{Scan header page to see if database is online - assumes that service is already set up}
248	Result := true;
249	with IBStatisticalService1 do
250	begin
251	Options := [HeaderPages];
252	DatabaseName := DBName;
253	Lines := TStringList.Create;
254	try
255	Execute(Lines);
256	for i := 0 to Lines.Count - 1 do
257	begin
258	line := Lines[i];
259	if (Pos('Attributes',Line) <> 0) and ((Pos('database shutdown',Line) <> 0)
260	or (Pos('multi-user maintenance',Line) <> 0)) then
261	begin
262	Result := false;
263	break;
264	end;
265
266	end;
267	finally
268	Lines.Free;
269	end
270	end;
271	end;
272
273	procedure TMainForm.CLoseBtnClick(Sender: TObject);
274	begin
275	Close
276	end;
277
278	procedure TMainForm.BringOnlineExecute(Sender: TObject);
279	var aDBName: string;
280	begin
281	aDBName := DBName;
282	if SelectDBDlg.ShowModal(aDBName) = mrOK then
283	begin
284	DBName := aDBName;
285	if IsDatabaseOnline then
286	MessageDlg('Database is already online!',mtInformation,[mbOK],0)
287	else
288	begin
289	IBConfigService1.DatabaseName := DBName;
290	IBConfigService1.BringDatabaseOnline;
291	if IsDatabaseOnline then
292	MessageDlg('Database is back online',mtInformation,[mbOK],0)
293	else
294	MessageDlg('Database is still shutdown!',mtError,[mbOK],0);
295	end;
296	end;
297	end;
298
299	procedure TMainForm.BringOnlineUpdate(Sender: TObject);
300	begin
301	(Sender as TAction).Enabled := not ShutdownDatabaseDlg.Aborting;
302	end;
303
304	procedure TMainForm.BackupBtnClick(Sender: TObject);
305	var aDBName: string;
306	begin
307	aDBName := DBName;
308	if BackupDlg.ShowModal(aDBName,Memo1.Lines) = mrOK then
309	DBName := aDBName;
310	end;
311
312	{Logon to the current security database on the server}
313
314	procedure TMainForm.IBXServicesConnection1Login(
315	Service: TIBXServicesConnection; var aServerName: string; LoginParams: TStrings);
316	var aServiceName: string;
317	aUserName: string;
318	aPassword: string;
319	begin
320	aServiceName := aServerName;
321	aUserName := LoginParams.Values['user_name'];
322	aPassword := '';
323	if SvcLoginDlg.ShowModal(aServiceName, aUserName, aPassword) = mrOK then
324	begin
325	Service.ServerName := aServiceName;
326	LoginParams.Values['user_name'] := aUserName;
327	LoginParams.Values['password'] := aPassword;
328	FServerUserName := aUserName;
329	FServerPassword := aPassword;
330	aServerName := aServiceName;
331	end
332	else
333	IBError(ibxeOperationCancelled, [nil]);
334	end;
335
336	procedure TMainForm.IBXServicesConnection1SecurityContextException(
337	Service: TIBXServicesConnection; var aAction: TSecContextAction);
338	begin
339	if MessageDlg(sSecContext,mtInformation,[mbYes,mbNo],0) = mrYes then
340	aAction := scReconnect;
341	end;
342
343	procedure TMainForm.RestoreBtnClick(Sender: TObject);
344	var aDBName: string;
345	begin
346	aDBName := DBName;
347	if RestoreDlg.ShowModal(aDBName,Memo1.Lines) = mrOK then
348	DBName := aDBName;
349	end;
350
351	procedure TMainForm.ServerLOgBtnClick(Sender: TObject);
352	begin
353	Memo1.Lines.Add('Server Log');
354	IBLogService1.Execute(Memo1.Lines);
355	end;
356
357	procedure TMainForm.DatabaseBtnClick(Sender: TObject);
358	begin
359	PopupMenu1.PopUp(Mouse.CursorPos.X,Mouse.CursorPos.Y);
360	end;
361
362	procedure TMainForm.ShutdownExecute(Sender: TObject);
363	var aDBName: string;
364	begin
365	aDBName := DBName;
366	FShutDownMode := DenyTransaction;
367	if ShutdownReqDlg.ShowModal(aDBName,FShutDownMode,FDelay) = mrOK then
368	begin
369	DBName := aDBName;
370	if not IsDatabaseOnline then
371	MessageDlg('Database is already shutdown!',mtInformation,[mbOK],0)
372	else
373	ShutdownDatabaseDlg.Shutdown(DBName,FShutDownMode,FDelay);
374	end;
375	end;
376
377	procedure TMainForm.SweepExecute(Sender: TObject);
378	var aDBName: string;
379	begin
380	aDBName := DBName;
381	if SelectDBDlg.ShowModal(aDBName) = mrOK then
382	with IBValidationService1 do
383	begin
384	DBName := aDBName;
385	DatabaseName := DBName;
386	Options := [SweepDB];
387	Memo1.Lines.Add(Format(sDBSweep,[DatabaseName]));
388	Execute(Memo1.Lines);
389	Memo1.Lines.Add(sSweepOK);
390	end;
391	end;
392
393	procedure TMainForm.UsersBtnClick(Sender: TObject);
394	begin
395	ListUsersForm.ShowModal;
396	end;
397
398	end.
399