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 IBMessages, 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}
  IBXServicesConnection1.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('Firebird Library PathName = ' + IBXServicesConnection1.FirebirdAPI.GetFBLibrary.GetLibraryFilePath);
    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:	291
Committed:	Fri Apr 17 10:26:08 2020 UTC (4 years, 8 months ago) by tony
Content type:	text/x-pascal
File size:	12292 byte(s)
Log Message:	Changed for 2.3.4 merged into public release
#	User	Rev	Content
1	tony	143	(*
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	tony	209	ActnList, Menus, IBXServices, IB;
36	tony	143
37	tony	209	const
38			sDefaultDatabaseName = 'employee';
39
40	tony	143	type
41
42			TRunServiceProc = procedure of object;
43
44			{ TMainForm }
45
46			TMainForm = class(TForm)
47	tony	209	IBConfigService1: TIBXConfigService;
48			IBXServicesConnection1: TIBXServicesConnection;
49	tony	143	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	tony	209	IBLogService1: TIBXLogService;
70			IBOnlineValidationService1: TIBXOnlineValidationService;
71			IBServerProperties1: TIBXServerProperties;
72			IBStatisticalService1: TIBXStatisticalService;
73			IBValidationService1: TIBXValidationService;
74	tony	143	Memo1: TMemo;
75			procedure BringOnlineExecute(Sender: TObject);
76			procedure BringOnlineUpdate(Sender: TObject);
77			procedure CLoseBtnClick(Sender: TObject);
78			procedure BackupBtnClick(Sender: TObject);
79	tony	209	procedure IBXServicesConnection1Login(Service: TIBXServicesConnection;
80			var aServerName: string; LoginParams: TStrings);
81			procedure IBXServicesConnection1SecurityContextException(
82			Service: TIBXServicesConnection; var aAction: TSecContextAction);
83	tony	143	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	tony	209	FShutDownMode: TDBShutdownMode;
99	tony	143	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	tony	291	uses IBMessages, ServicesLoginDlgUnit, SelectValidationDlgUnit, SelectDBDlgUnit,
115	tony	209	BackupDlgUnit, RestoreDlgUnit, ListUsersUnit, LimboTransactionsUnit,
116	tony	143	ShutdownDatabaseDlgUnit, ShutdownRegDlgUnit;
117
118			resourcestring
119			sDBSweep = 'Database sweep started';
120			sSweepOK = 'Sweep successfully completed';
121	tony	209	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	tony	143
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	tony	263	IBXServicesConnection1.FirebirdAPI.GetStatus.SetIBDataBaseErrorMessages([ShowIBMessage]);
133	tony	209	Application.ExceptionDialog := aedOkMessageBox;
134			FDBName := sDefaultDatabaseName;
135
136			{Open the Services API connection }
137			with IBXServicesConnection1 do
138	tony	143	begin
139	tony	209	while not Connected do
140	tony	143	begin
141			try
142	tony	209	Connected := true;
143	tony	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	tony	209	end;
154	tony	143
155	tony	209	{Now display the server properties}
156			with IBServerProperties1, ServicesConnection do
157			begin
158	tony	263	Memo1.Lines.Add('Firebird Library PathName = ' + IBXServicesConnection1.FirebirdAPI.GetFBLibrary.GetLibraryFilePath);
159	tony	143	Memo1.Lines.Add('Server Version = ' + VersionInfo.ServerVersion);
160			Memo1.Lines.Add('Server Implementation = ' + VersionInfo.ServerImplementation);
161			Memo1.Lines.Add('Service Version = ' + IntToStr(VersionInfo.ServiceVersion));
162			Memo1.Lines.Add(Format('Firebird Release = %d.%d.%d (Build no. %d)',[ServerVersionNo[1],
163			ServerVersionNo[2],
164			ServerVersionNo[3],
165			ServerVersionNo[4]]));
166			Memo1.Lines.Add('No. of attachments = ' + IntToStr(DatabaseInfo.NoOfAttachments));
167			Memo1.Lines.Add('No. of databases = ' + IntToStr(DatabaseInfo.NoOfDatabases));
168			for i := 0 to DatabaseInfo.NoOfDatabases - 1 do
169			Memo1.Lines.Add('DB Name = ' + DatabaseInfo.DbName[i]);
170			Memo1.Lines.Add('Base Location = ' + ConfigParams.BaseLocation);
171			Memo1.Lines.Add('Lock File Location = ' + ConfigParams.LockFileLocation);
172			Memo1.Lines.Add('Security Database Location = ' + ConfigParams.SecurityDatabaseLocation);
173			Memo1.Lines.Add('Message File Location = ' + ConfigParams.MessageFileLocation);
174			for i := Low(ConfigParams.ConfigFileParams) to High(ConfigParams.ConfigFileParams) do
175	tony	209	Memo1.Lines.Add(ConfigParams.ConfigFileParams[i]);
176	tony	143	for i := Low(ConfigParams.ConfigFileData.ConfigFileKey) to High(ConfigParams.ConfigFileData.ConfigFileKey) do
177	tony	209	Memo1.Lines.Add(Format('%d=%s',[ConfigParams.ConfigFileData.ConfigFileKey[i],ConfigParams.ConfigFileData.ConfigFileValue[i]]));
178	tony	143	end;
179			end;
180
181
182			procedure TMainForm.LimboTransactionsExecute(Sender: TObject);
183			var aDBName: string;
184			begin
185			aDBName := DBName;
186			with LimboTransactionsForm do
187			begin
188			if SelectDBDlg.ShowModal(aDBName) = mrOK then
189			begin
190			DBName := aDBName;
191	tony	209	IBXLimboTransactionResolutionService1.DatabaseName := DBName;
192			ShowModal;
193	tony	143	end;
194			end;
195			end;
196
197			procedure TMainForm.StatisticsExecute(Sender: TObject);
198			var aDBName: string;
199			begin
200			aDBName := DBName;
201			if SelectDBDlg.ShowModal(aDBName) = mrOK then
202			begin
203			DBName := aDBName;
204			IBStatisticalService1.Options := [DataPages];
205	tony	209	IBStatisticalService1.DatabaseName := DBName;
206			Memo1.Lines.Add('Database Statistics for ' + IBStatisticalService1.DatabaseName);
207			IBStatisticalService1.Execute(Memo1.Lines);
208	tony	143	end;
209			end;
210
211			procedure TMainForm.ValidateExecute(Sender: TObject);
212			var UseOnlineValidation: boolean;
213			aDBName: string;
214			begin
215			UseOnlineValidation := false;
216			aDBName := DBName;
217	tony	209	if SelectValidationDlg.ShowModal(IBXServicesConnection1.ServerName,aDBName,UseOnlineValidation) = mrOK then
218	tony	143	begin
219			DBName := aDBName;
220	tony	209	Memo1.Lines.Add('Running...');
221	tony	143	if UseOnlineValidation then
222	tony	209	begin
223			IBOnlineValidationService1.DatabaseName := DBName;
224			IBOnlineValidationService1.Execute(Memo1.Lines);
225			end
226	tony	143	else
227			begin
228			IBValidationService1.Options := [ValidateFull];
229	tony	209	IBValidationService1.DatabaseName := DBName;
230			IBValidationService1.Execute(Memo1.Lines);
231	tony	143	end;
232	tony	209	Memo1.Lines.Add('Validation Completed');
233			MessageDlg('Validation Completed',mtInformation,[mbOK],0);
234	tony	143	end;
235			end;
236
237			procedure TMainForm.SetDBName(AValue: string);
238			begin
239			if FDBName = AValue then Exit;
240			FDBName := AValue;
241			end;
242
243			function TMainForm.IsDatabaseOnline: boolean;
244	tony	209	var Lines: TStringList;
245			i: integer;
246			line: string;
247	tony	143	begin
248			{Scan header page to see if database is online - assumes that service is already set up}
249			Result := true;
250			with IBStatisticalService1 do
251			begin
252			Options := [HeaderPages];
253	tony	209	DatabaseName := DBName;
254			Lines := TStringList.Create;
255	tony	143	try
256	tony	209	Execute(Lines);
257			for i := 0 to Lines.Count - 1 do
258	tony	143	begin
259	tony	209	line := Lines[i];
260	tony	143	if (Pos('Attributes',Line) <> 0) and ((Pos('database shutdown',Line) <> 0)
261			or (Pos('multi-user maintenance',Line) <> 0)) then
262	tony	209	begin
263	tony	143	Result := false;
264	tony	209	break;
265			end;
266	tony	143
267			end;
268			finally
269	tony	209	Lines.Free;
270	tony	143	end
271			end;
272			end;
273
274			procedure TMainForm.CLoseBtnClick(Sender: TObject);
275			begin
276			Close
277			end;
278
279			procedure TMainForm.BringOnlineExecute(Sender: TObject);
280			var aDBName: string;
281			begin
282			aDBName := DBName;
283			if SelectDBDlg.ShowModal(aDBName) = mrOK then
284			begin
285			DBName := aDBName;
286	tony	209	if IsDatabaseOnline then
287			MessageDlg('Database is already online!',mtInformation,[mbOK],0)
288			else
289			begin
290			IBConfigService1.DatabaseName := DBName;
291			IBConfigService1.BringDatabaseOnline;
292			if IsDatabaseOnline then
293			MessageDlg('Database is back online',mtInformation,[mbOK],0)
294			else
295			MessageDlg('Database is still shutdown!',mtError,[mbOK],0);
296			end;
297	tony	143	end;
298			end;
299
300			procedure TMainForm.BringOnlineUpdate(Sender: TObject);
301			begin
302			(Sender as TAction).Enabled := not ShutdownDatabaseDlg.Aborting;
303			end;
304
305			procedure TMainForm.BackupBtnClick(Sender: TObject);
306	tony	209	var aDBName: string;
307	tony	143	begin
308	tony	209	aDBName := DBName;
309			if BackupDlg.ShowModal(aDBName,Memo1.Lines) = mrOK then
310			DBName := aDBName;
311			end;
312
313			{Logon to the current security database on the server}
314
315			procedure TMainForm.IBXServicesConnection1Login(
316			Service: TIBXServicesConnection; var aServerName: string; LoginParams: TStrings);
317			var aServiceName: string;
318			aUserName: string;
319			aPassword: string;
320			begin
321			aServiceName := aServerName;
322			aUserName := LoginParams.Values['user_name'];
323			aPassword := '';
324			if SvcLoginDlg.ShowModal(aServiceName, aUserName, aPassword) = mrOK then
325	tony	143	begin
326	tony	209	Service.ServerName := aServiceName;
327			LoginParams.Values['user_name'] := aUserName;
328			LoginParams.Values['password'] := aPassword;
329			FServerUserName := aUserName;
330			FServerPassword := aPassword;
331			aServerName := aServiceName;
332			end
333			else
334			IBError(ibxeOperationCancelled, [nil]);
335	tony	143	end;
336
337	tony	209	procedure TMainForm.IBXServicesConnection1SecurityContextException(
338			Service: TIBXServicesConnection; var aAction: TSecContextAction);
339			begin
340			if MessageDlg(sSecContext,mtInformation,[mbYes,mbNo],0) = mrYes then
341			aAction := scReconnect;
342			end;
343
344	tony	143	procedure TMainForm.RestoreBtnClick(Sender: TObject);
345	tony	209	var aDBName: string;
346	tony	143	begin
347	tony	209	aDBName := DBName;
348			if RestoreDlg.ShowModal(aDBName,Memo1.Lines) = mrOK then
349			DBName := aDBName;
350	tony	143	end;
351
352			procedure TMainForm.ServerLOgBtnClick(Sender: TObject);
353			begin
354			Memo1.Lines.Add('Server Log');
355	tony	209	IBLogService1.Execute(Memo1.Lines);
356	tony	143	end;
357
358			procedure TMainForm.DatabaseBtnClick(Sender: TObject);
359			begin
360			PopupMenu1.PopUp(Mouse.CursorPos.X,Mouse.CursorPos.Y);
361			end;
362
363			procedure TMainForm.ShutdownExecute(Sender: TObject);
364			var aDBName: string;
365			begin
366			aDBName := DBName;
367			FShutDownMode := DenyTransaction;
368			if ShutdownReqDlg.ShowModal(aDBName,FShutDownMode,FDelay) = mrOK then
369			begin
370			DBName := aDBName;
371	tony	209	if not IsDatabaseOnline then
372			MessageDlg('Database is already shutdown!',mtInformation,[mbOK],0)
373			else
374			ShutdownDatabaseDlg.Shutdown(DBName,FShutDownMode,FDelay);
375	tony	143	end;
376			end;
377
378			procedure TMainForm.SweepExecute(Sender: TObject);
379			var aDBName: string;
380			begin
381			aDBName := DBName;
382			if SelectDBDlg.ShowModal(aDBName) = mrOK then
383	tony	209	with IBValidationService1 do
384	tony	143	begin
385			DBName := aDBName;
386	tony	209	DatabaseName := DBName;
387			Options := [SweepDB];
388			Memo1.Lines.Add(Format(sDBSweep,[DatabaseName]));
389			Execute(Memo1.Lines);
390			Memo1.Lines.Add(sSweepOK);
391	tony	143	end;
392			end;
393
394			procedure TMainForm.UsersBtnClick(Sender: TObject);
395			begin
396	tony	209	ListUsersForm.ShowModal;
397	tony	143	end;
398
399			end.
400