ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/examples/DBAdmin/MainFormUnit.pas
Revision: 263
Committed: Thu Dec 6 15:55:01 2018 UTC (5 years, 4 months ago) by tony
Content type: text/x-pascal
File size: 35886 byte(s)
Log Message:
Release 2.3.2 committed

File Contents

# Content
1 (*
2 * MainFormUnit.pas
3 * Copyright (C) 2018 Tony Whyman <tony@mwasoftware.co.uk>
4 *
5 * DBAdmin is free software: you can redistribute it and/or modify it
6 * under the terms of the GNU General Public License as published by the
7 * Free Software Foundation, either version 3 of the License, or
8 * (at your option) any later version.
9 *
10 * DBAdmin is distributed in the hope that it will be useful, but
11 * WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
13 * See the GNU General Public License for more details.
14 *
15 * You should have received a copy of the GNU General Public License along
16 * with this program. If not, see <http://www.gnu.org/licenses/>.
17 *)
18 unit MainFormUnit;
19
20 {$mode objfpc}{$H+}
21
22 interface
23
24 uses
25 Classes, SysUtils, FileUtil, SynEdit, SynHighlighterSQL,
26 SynGutterCodeFolding, Forms, Controls, Graphics, Dialogs, Menus, ComCtrls,
27 ActnList, StdCtrls, DbCtrls, ExtCtrls, Buttons, db, IBLookupComboEditBox,
28 IBDynamicGrid, IBTreeView, IBDatabaseInfo, IBXServices, IBExtract, IB;
29
30 type
31
32 { TMainForm }
33
34 TMainForm = class(TForm)
35 AccessRightsPopup: TPopupMenu;
36 AccessRightsSource: TDataSource;
37 ClientLibrary: TLabel;
38 MenuItem20: TMenuItem;
39 MenuItem21: TMenuItem;
40 RunScript: TAction;
41 AutoAdmin: TCheckBox;
42 DatabaseAliasName: TEdit;
43 DBEdit5: TDBEdit;
44 DBEdit6: TDBEdit;
45 IncludeUserGrants: TCheckBox;
46 Label41: TLabel;
47 Label42: TLabel;
48 Label43: TLabel;
49 DBComments: TMemo;
50 MenuItem19: TMenuItem;
51 RevokeAll: TAction;
52 AuthMapSource: TDataSource;
53 SubjectAccessRightsSource: TDataSource;
54 DBTablesSource: TDataSource;
55 IBDynamicGrid5: TIBDynamicGrid;
56 SubjectAccessRightsGrid: TIBDynamicGrid;
57 AccessRightsTreeView: TIBTreeView;
58 SelectAllTables: TCheckBox;
59 Label40: TLabel;
60 SelectedTablesGrid: TIBDynamicGrid;
61 Label37: TLabel;
62 Panel8: TPanel;
63 DBTablesPanel: TPanel;
64 Panel9: TPanel;
65 Phase2Repair: TAction;
66 ApplySelected: TAction;
67 AuthMethLabel: TLabel;
68 AuthMethod: TDBEdit;
69 Button7: TButton;
70 IgnoreChecksumsOnRepair: TCheckBox;
71 DBTablesSplitter: TSplitter;
72 Alltables: TRadioButton;
73 SelectedTablesOnly: TRadioButton;
74 MappingsTab: TTabSheet;
75 AccessRightsTab: TTabSheet;
76 Splitter5: TSplitter;
77 ToolButton6: TToolButton;
78 ToolButton7: TToolButton;
79 UpdateColsPanel: TPanel;
80 ValidateRepairRecordFragments: TCheckBox;
81 IgnoreChecksums: TCheckBox;
82 Label34: TLabel;
83 ReadOnlyValidation: TCheckBox;
84 RecordFragments: TCheckBox;
85 Commit2Phase: TAction;
86 DBOwner: TEdit;
87 AttmntODS12Panel: TPanel;
88 Label33: TLabel;
89 RepairOptionsTab: TTabSheet;
90 ValidateOptions: TPageControl;
91 RemoteOSLabel: TLabel;
92 RemoteOSUser: TDBEdit;
93 SecDatabase: TEdit;
94 RollbackAll: TAction;
95 CommitAll: TAction;
96 Button3: TButton;
97 Button4: TButton;
98 Button5: TButton;
99 Button6: TButton;
100 IBDynamicGrid3: TIBDynamicGrid;
101 Label38: TLabel;
102 Label39: TLabel;
103 LimboListSource: TDataSource;
104 LimboReport: TMemo;
105 RunRepair: TAction;
106 Button2: TButton;
107 SelectRepairAction: TComboBox;
108 DisconnectAttachment: TAction;
109 LimboTab: TTabSheet;
110 ValidateOptionsTab: TTabSheet;
111 MenuItem17: TMenuItem;
112 AttmtPopup: TPopupMenu;
113 MenuItem18: TMenuItem;
114 RepairTab: TTabSheet;
115 ToggleAutoRefresh: TAction;
116 AttachSource: TDataSource;
117 DBCheckBox1: TDBCheckBox;
118 DBEdit2: TDBEdit;
119 DBEdit3: TDBEdit;
120 DBEdit7: TDBEdit;
121 DeleteTag: TAction;
122 AddTag: TAction;
123 AttmtGrid: TIBDynamicGrid;
124 Label31: TLabel;
125 Label32: TLabel;
126 Label35: TLabel;
127 MenuItem11: TMenuItem;
128 MenuItem12: TMenuItem;
129 MenuItem13: TMenuItem;
130 MenuItem14: TMenuItem;
131 MenuItem15: TMenuItem;
132 MenuItem16: TMenuItem;
133 Panel7: TPanel;
134 AttDetailsPanel: TPanel;
135 UserPopup: TPopupMenu;
136 UserTagPopup: TPopupMenu;
137 SaveChanges: TAction;
138 DeleteUser: TAction;
139 ChgPassword: TAction;
140 AddUser: TAction;
141 AddFileBtn: TButton;
142 AddShadowBtn: TButton;
143 AllocatedPages: TEdit;
144 Button1: TButton;
145 DatabaseOnline: TCheckBox;
146 DBCharacterSet: TIBLookupComboEditBox;
147 DBCharSetRO: TDBEdit;
148 DBEdit1: TDBEdit;
149 DBEdit4: TDBEdit;
150 DBIsReadOnly: TCheckBox;
151 DBText1: TDBText;
152 DropDatabase: TAction;
153 Edit1: TEdit;
154 Edit10: TEdit;
155 Edit11: TEdit;
156 PageBuffers: TEdit;
157 ODSVersionString: TEdit;
158 ServerVersionNo: TEdit;
159 DBSQLDialect: TEdit;
160 ConnectString: TEdit;
161 UserManagerTab: TTabSheet;
162 FilesTab: TTabSheet;
163 IBDynamicGrid1: TIBDynamicGrid;
164 IBDynamicGrid2: TIBDynamicGrid;
165 AttmtTimer: TTimer;
166 UserManagerGrid: TIBDynamicGrid;
167 IBDynamicGrid4: TIBDynamicGrid;
168 TagsGrid: TIBDynamicGrid;
169 IsShadowChk: TCheckBox;
170 Label1: TLabel;
171 Label10: TLabel;
172 Label11: TLabel;
173 Label12: TLabel;
174 Label13: TLabel;
175 Label14: TLabel;
176 Label15: TLabel;
177 Label16: TLabel;
178 Label17: TLabel;
179 Label18: TLabel;
180 Label19: TLabel;
181 Label2: TLabel;
182 Label20: TLabel;
183 Label21: TLabel;
184 Label22: TLabel;
185 Label23: TLabel;
186 Label24: TLabel;
187 Label25: TLabel;
188 Label26: TLabel;
189 Label27: TLabel;
190 Label28: TLabel;
191 Label29: TLabel;
192 Label3: TLabel;
193 Label30: TLabel;
194 Label36: TLabel;
195 Label4: TLabel;
196 Label5: TLabel;
197 Label6: TLabel;
198 Label7: TLabel;
199 Label8: TLabel;
200 Label9: TLabel;
201 LingerDelay: TEdit;
202 MenuItem10: TMenuItem;
203 MenuItem9: TMenuItem;
204 MenuItem8: TMenuItem;
205 NoReserve: TCheckBox;
206 PageControl1: TPageControl;
207 PagesAvail: TEdit;
208 PagesUsed: TEdit;
209 Panel1: TPanel;
210 Panel2: TPanel;
211 Panel3: TPanel;
212 Panel4: TPanel;
213 Panel5: TPanel;
214 Panel6: TPanel;
215 TagsHeader: TPanel;
216 PrimaryDBFile: TEdit;
217 Properties: TTabSheet;
218 RemoveShadowBtn: TButton;
219 RoleSource: TDataSource;
220 Save: TAction;
221 IBExtract1: TIBExtract;
222 SaveDialog: TSaveDialog;
223 SchemaTab: TTabSheet;
224 ServerLog: TMemo;
225 ServerPropMemo: TMemo;
226 ServerTab: TTabSheet;
227 Splitter1: TSplitter;
228 Splitter2: TSplitter;
229 Splitter3: TSplitter;
230 Splitter4: TSplitter;
231 SQlSaveDialog: TSaveDialog;
232 RemoveShadow: TAction;
233 AddShadowSet: TAction;
234 AddSecondary: TAction;
235 MenuItem6: TMenuItem;
236 MenuItem7: TMenuItem;
237 OpenDatabase: TAction;
238 CharSetSource: TDataSource;
239 DatabaseSource: TDataSource;
240 AttmtSource: TDataSource;
241 DBCharSetSource: TDataSource;
242 IBDatabaseInfo: TIBDatabaseInfo;
243 MenuItem3: TMenuItem;
244 MenuItem4: TMenuItem;
245 MenuItem5: TMenuItem;
246 Restore: TAction;
247 Backup: TAction;
248 MenuImages: TImageList;
249 MenuItem1: TMenuItem;
250 MenuItem2: TMenuItem;
251 Quit: TAction;
252 ActionList1: TActionList;
253 MainMenu1: TMainMenu;
254 SecDBFilesSource: TDataSource;
255 ShadowSource: TDataSource;
256 StatisticsTab: TTabSheet;
257 StatsMemo: TMemo;
258 StatsOptions: TComboBox;
259 StatusBar1: TStatusBar;
260 SweepInterval: TEdit;
261 SyncWrites: TCheckBox;
262 SynEdit1: TSynEdit;
263 SynSQLSyn1: TSynSQLSyn;
264 AttachmentsTab: TTabSheet;
265 ToolBar1: TToolBar;
266 ToolButton1: TToolButton;
267 ToolButton2: TToolButton;
268 ToolButton3: TToolButton;
269 ToolButton4: TToolButton;
270 ToolButton5: TToolButton;
271 UserListSource: TDataSource;
272 UserTagsSource: TDataSource;
273 ValidationReport: TMemo;
274 procedure AccessRightsTabHide(Sender: TObject);
275 procedure AccessRightsTabShow(Sender: TObject);
276 procedure AddSecondaryExecute(Sender: TObject);
277 procedure AddShadowSetExecute(Sender: TObject);
278 procedure AddTagExecute(Sender: TObject);
279 procedure AddTagUpdate(Sender: TObject);
280 procedure AddUserExecute(Sender: TObject);
281 procedure AddUserUpdate(Sender: TObject);
282 procedure ApplySelectedExecute(Sender: TObject);
283 procedure AttachmentsTabHide(Sender: TObject);
284 procedure AttachmentsTabShow(Sender: TObject);
285 procedure AttmtTimerTimer(Sender: TObject);
286 procedure AutoAdminChange(Sender: TObject);
287 procedure BackupExecute(Sender: TObject);
288 procedure ChgPasswordExecute(Sender: TObject);
289 procedure ChgPasswordUpdate(Sender: TObject);
290 procedure Commit2PhaseExecute(Sender: TObject);
291 procedure CommitAllExecute(Sender: TObject);
292 procedure CommitAllUpdate(Sender: TObject);
293 procedure DatabaseOnlineChange(Sender: TObject);
294 procedure DBCharacterSetEditingDone(Sender: TObject);
295 procedure DBCommentsEditingDone(Sender: TObject);
296 procedure DBIsReadOnlyChange(Sender: TObject);
297 procedure DBSQLDialectEditingDone(Sender: TObject);
298 procedure DeleteTagExecute(Sender: TObject);
299 procedure DeleteTagUpdate(Sender: TObject);
300 procedure DeleteUserExecute(Sender: TObject);
301 procedure DeleteUserUpdate(Sender: TObject);
302 procedure DisconnectAttachmentExecute(Sender: TObject);
303 procedure DisconnectAttachmentUpdate(Sender: TObject);
304 procedure DropDatabaseExecute(Sender: TObject);
305 procedure DropDatabaseUpdate(Sender: TObject);
306 procedure AccessRightsTreeViewSelectionChanged(Sender: TObject);
307 procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
308 procedure MappingsTabHide(Sender: TObject);
309 procedure MappingsTabShow(Sender: TObject);
310 procedure PageBuffersEditingDone(Sender: TObject);
311 procedure QuitExecute(Sender: TObject);
312 procedure RepairTabHide(Sender: TObject);
313 procedure RepairTabShow(Sender: TObject);
314 procedure RevokeAllExecute(Sender: TObject);
315 procedure RevokeAllUpdate(Sender: TObject);
316 procedure RunScriptExecute(Sender: TObject);
317 procedure SelectAllTablesChange(Sender: TObject);
318 procedure SelectedTablesOnlyChange(Sender: TObject);
319 procedure SelectRepairActionCloseUp(Sender: TObject);
320 procedure SubjectAccessRightsSourceDataChange(Sender: TObject; Field: TField
321 );
322 procedure UserManagerTabHide(Sender: TObject);
323 procedure UserManagerTabShow(Sender: TObject);
324 procedure FilesTabShow(Sender: TObject);
325 procedure FormShow(Sender: TObject);
326 procedure IsShadowChkChange(Sender: TObject);
327 procedure LimboTabHide(Sender: TObject);
328 procedure LimboTabShow(Sender: TObject);
329 procedure LingerDelayEditingDone(Sender: TObject);
330 procedure NoReserveChange(Sender: TObject);
331 procedure OpenDatabaseExecute(Sender: TObject);
332 procedure PropertiesShow(Sender: TObject);
333 procedure RemoveShadowExecute(Sender: TObject);
334 procedure RemoveShadowUpdate(Sender: TObject);
335 procedure RestoreExecute(Sender: TObject);
336 procedure RollbackAllExecute(Sender: TObject);
337 procedure RunRepairExecute(Sender: TObject);
338 procedure SaveChangesExecute(Sender: TObject);
339 procedure SaveChangesUpdate(Sender: TObject);
340 procedure SaveExecute(Sender: TObject);
341 procedure SaveUpdate(Sender: TObject);
342 procedure SchemaTabShow(Sender: TObject);
343 procedure ServerTabHide(Sender: TObject);
344 procedure ServerTabShow(Sender: TObject);
345 procedure StatisticsTabHide(Sender: TObject);
346 procedure StatisticsTabShow(Sender: TObject);
347 procedure StatsOptionsCloseUp(Sender: TObject);
348 procedure SweepIntervalEditingDone(Sender: TObject);
349 procedure SyncWritesChange(Sender: TObject);
350 procedure ToggleAutoRefreshExecute(Sender: TObject);
351 procedure ToggleAutoRefreshUpdate(Sender: TObject);
352 private
353 FLoading: boolean;
354 FLastStatsIndex: integer;
355 FServerError: boolean;
356 procedure HandleDBConnect(Sender: TObject);
357 procedure HandleLoadData(Sender: TObject);
358 procedure LoadData;
359 procedure DoExtract(Data: PtrInt);
360 procedure ConfigureForServerVersion;
361 procedure ConfigureOnlineValidation;
362 public
363 end;
364
365 var
366 MainForm: TMainForm;
367
368 implementation
369
370 {$R *.lfm}
371
372 uses DataModule, ShutdownRegDlgUnit, AddSecondaryFileDlgUnit, NewUserDlgUnit,
373 ChgPasswordDlgUnit, FBMessages, ExecuteSQLScriptDlgUnit;
374
375 { TMainForm }
376
377 procedure TMainForm.FormShow(Sender: TObject);
378 begin
379 {Set IB Exceptions to only show text message - omit SQLCode and Engine Code}
380 DatabaseData.IBDatabase1.FirebirdAPI.GetStatus.SetIBDataBaseErrorMessages([ShowIBMessage]);
381 Application.ExceptionDialog := aedOkMessageBox;
382 PageControl1.ActivePage := Properties;
383 DatabaseData.AfterDBConnect := @HandleDBConnect;
384 DatabaseData.AfterDataReload := @HandleLoadData;
385 AccessRightsTreeView.DataSource := nil;
386 AccessRightsTreeView.DataSource := AccessRightsSource;
387 SubjectAccessRightsGrid.DataSource := nil;
388 SubjectAccessRightsGrid.DataSource := SubjectAccessRightsSource;
389 DatabaseData.Connect;
390 if not DatabaseData.IBDatabase1.Connected then Close;
391 end;
392
393 procedure TMainForm.IsShadowChkChange(Sender: TObject);
394 begin
395 if FLoading then Exit;
396 if not DatabaseData.IsShadowDatabase then
397 begin
398 MessageDlg('A Normal Database cannot be changed into a Shadow Database',mtError,[mbOK],0);
399 FLoading := true;
400 try
401 IsShadowChk.Checked := false;
402 finally
403 FLoading := false;
404 end;
405 end
406 else
407 DatabaseData.ActivateShadow;
408 end;
409
410 procedure TMainForm.LimboTabHide(Sender: TObject);
411 begin
412 LimboListSource.DataSet.Active := false;
413 end;
414
415 procedure TMainForm.LimboTabShow(Sender: TObject);
416 begin
417 if not Visible or not IBDatabaseInfo.Database.Connected then Exit;
418 LimboListSource.DataSet.Active := true;
419 end;
420
421 procedure TMainForm.LingerDelayEditingDone(Sender: TObject);
422 begin
423 if FLoading then Exit;
424 DatabaseData.LingerDelay := LingerDelay.Text;
425 end;
426
427 procedure TMainForm.NoReserveChange(Sender: TObject);
428 begin
429 if FLoading then Exit;
430 DatabaseData.NoReserve := NoReserve.Checked;
431 end;
432
433 procedure TMainForm.DBCharacterSetEditingDone(Sender: TObject);
434 begin
435 with DBCharSetSource.Dataset do
436 if State = dsEdit then
437 Post;
438 end;
439
440 procedure TMainForm.DBCommentsEditingDone(Sender: TObject);
441 begin
442 DatabaseData.Description := DBComments.Lines.Text;
443 end;
444
445 procedure TMainForm.AutoAdminChange(Sender: TObject);
446 begin
447 if FLoading then Exit;
448 try
449 DatabaseData.AutoAdmin := AutoAdmin.Checked;
450 except on E:Exception do
451 begin
452 MessageDlg(E.message,mtError,[mbOK],0);
453 FLoading := true;
454 try
455 AutoAdmin.Checked := not AutoAdmin.Checked;
456 finally
457 FLoading := false;
458 end;
459 end;
460 end;
461 end;
462
463 procedure TMainForm.AddSecondaryExecute(Sender: TObject);
464 var FileName: string;
465 StartAt: integer;
466 FileLength: integer;
467 Pages: boolean;
468 begin
469 StartAt := 0;
470 if DatabaseData.IsDatabaseOnline then
471 begin
472 MessageDlg('The database must be shutdown before adding secondary files',
473 mtError,[mbOK],0);
474 exit;
475 end;
476
477 if AddSecondaryFileDlg.ShowModal(FileName,StartAt,FileLength,Pages) = mrOK then
478 begin
479 if not Pages then
480 begin
481 StartAt := StartAt*1024*1024 div IBDatabaseInfo.PageSize;
482 if FileLength <> -1 then
483 FileLength := FileLength*1024*1024 div IBDatabaseInfo.PageSize;
484 end;
485 DatabaseData.AddSecondaryFile(FileName,StartAt,FileLength);
486 end;
487 end;
488
489 procedure TMainForm.AccessRightsTabShow(Sender: TObject);
490 begin
491 if not Visible or not IBDatabaseInfo.Database.Connected then Exit;
492 UserListSource.DataSet.Active := true;
493 AccessRightsSource.DataSet.Active := true;
494 AccessRightsTreeViewSelectionChanged(nil);
495 end;
496
497 procedure TMainForm.AccessRightsTabHide(Sender: TObject);
498 begin
499 SubjectAccessRightsSource.DataSet.Active := false;
500 AccessRightsSource.DataSet.Active := false;
501 UserListSource.DataSet.Active := PageControl1.ActivePage = UserManagerTab;
502 end;
503
504 procedure TMainForm.AddShadowSetExecute(Sender: TObject);
505 begin
506 DatabaseData.AddShadowSet;
507 end;
508
509 procedure TMainForm.AddTagExecute(Sender: TObject);
510 begin
511 UserTagsSource.DataSet.Append;
512 end;
513
514 procedure TMainForm.AddTagUpdate(Sender: TObject);
515 begin
516 (Sender as TAction).Enabled := (UserTagsSource.State = dsBrowse);
517 end;
518
519 procedure TMainForm.AddUserExecute(Sender: TObject);
520 var NewUserName: string;
521 NewPassword: string;
522 begin
523 NewUserName := '';
524 if NewUserDlg.ShowModal(NewUserName,NewPassword) = mrOK then
525 with UserListSource.DataSet do
526 begin
527 Append;
528 FieldByName('SEC$USER_NAME').AsString := AnsiUpperCase(NewUserName);
529 FieldByName('SEC$PASSWORD').AsString := NewPassword;
530 end;
531 end;
532
533 procedure TMainForm.AddUserUpdate(Sender: TObject);
534 begin
535 (Sender as TAction).Enabled := (UserListSource.State = dsBrowse) and
536 ((DatabaseData.DBUserName = 'SYSDBA') or DatabaseData.HasUserAdminPrivilege);
537 end;
538
539 procedure TMainForm.ApplySelectedExecute(Sender: TObject);
540 begin
541 DatabaseData.LimboResolution(NoGlobalAction,LimboReport.Lines);
542 end;
543
544 procedure TMainForm.AttachmentsTabHide(Sender: TObject);
545 begin
546 AttachSource.DataSet.Active := false;
547 AttmtTimer.Enabled := false;
548 end;
549
550 procedure TMainForm.AttachmentsTabShow(Sender: TObject);
551 begin
552 if not Visible or not IBDatabaseInfo.Database.Connected then Exit;
553 AttachSource.DataSet.Active := true;
554 AttmtGrid.ShowEditorPanel; {assume located at current connection}
555 end;
556
557 procedure TMainForm.AttmtTimerTimer(Sender: TObject);
558 begin
559 DatabaseData.CurrentTransaction.Commit; {force a refresh}
560 end;
561
562 procedure TMainForm.BackupExecute(Sender: TObject);
563 begin
564 DatabaseData.BackupDatabase;
565 end;
566
567 procedure TMainForm.ChgPasswordExecute(Sender: TObject);
568 var NewPassword: string;
569 begin
570 NewPassword := '';
571 if ChgPasswordDlg.ShowModal(NewPassword) = mrOK then
572 with UserListSource.DataSet do
573 begin
574 Edit;
575 FieldByName('SEC$PASSWORD').AsString := NewPassword;
576 try
577 Post
578 except
579 Cancel;
580 raise;
581 end;
582 end;
583 end;
584
585 procedure TMainForm.ChgPasswordUpdate(Sender: TObject);
586 begin
587 (Sender as TAction).Enabled := UserListSource.DataSet.Active and (UserListSource.DataSet.RecordCount > 0);
588 end;
589
590 procedure TMainForm.Commit2PhaseExecute(Sender: TObject);
591 begin
592 DatabaseData.LimboResolution(RecoverTwoPhaseGlobal,LimboReport.Lines);
593 end;
594
595 procedure TMainForm.CommitAllExecute(Sender: TObject);
596 begin
597 DatabaseData.LimboResolution(CommitGlobal,LimboReport.Lines);
598 end;
599
600 procedure TMainForm.CommitAllUpdate(Sender: TObject);
601 begin
602 with LimboListSource.DataSet do
603 (Sender as TAction).Enabled := Active and (RecordCount > 0);
604 end;
605
606 procedure TMainForm.DatabaseOnlineChange(Sender: TObject);
607 var ShutDownMode: TDBShutDownMode;
608 Delay: integer;
609 begin
610 if FLoading then Exit;
611 ShutDownMode := DenyTransaction;
612 Delay := 60;
613 if DatabaseOnline.Checked then
614 DatabaseData.BringDatabaseOnline
615 else
616 if ShutdownReqDlg.ShowModal(DatabaseAliasName.Text,ShutDownMode,Delay) = mrOK then
617 DatabaseData.Shutdown(ShutdownMode,Delay);
618 end;
619
620 procedure TMainForm.DBIsReadOnlyChange(Sender: TObject);
621 begin
622 if FLoading then Exit;
623 try
624 DatabaseData.DBReadOnly := DBIsReadOnly.Checked;
625 except on E:Exception do
626 MessageDlg(E.message,mtError,[mbOK],0);
627 end;
628 end;
629
630 procedure TMainForm.DBSQLDialectEditingDone(Sender: TObject);
631 begin
632 if FLoading then Exit;
633 DatabaseData.DBSQLDialect := StrToInt(DBSQLDialect.Text);
634 end;
635
636 procedure TMainForm.DeleteTagExecute(Sender: TObject);
637 begin
638 UserTagsSource.DataSet.Delete;
639 end;
640
641 procedure TMainForm.DeleteTagUpdate(Sender: TObject);
642 begin
643 (Sender as TAction).Enabled := UserTagsSource.DataSet.Active and (UserTagsSource.DataSet.RecordCount > 0);
644 end;
645
646 procedure TMainForm.DeleteUserExecute(Sender: TObject);
647 begin
648 if MessageDlg('Do you really want to delete user ' + Trim(UserListSource.DataSet.FieldByName('SEC$USER_NAME').AsString),
649 mtConfirmation,[mbYes,mbNo],0) = mrYes then
650 UserListSource.DataSet.Delete;
651 end;
652
653 procedure TMainForm.DeleteUserUpdate(Sender: TObject);
654 begin
655 (Sender as TAction).Enabled := UserListSource.DataSet.Active and (UserListSource.DataSet.RecordCount > 0) and
656 ((DatabaseData.DBUserName = 'SYSDBA') or DatabaseData.HasUserAdminPrivilege);
657 end;
658
659 procedure TMainForm.DisconnectAttachmentExecute(Sender: TObject);
660 begin
661 if MessageDlg('Disconnect Attachment ID ' + AttachSource.DataSet.FieldByName('MON$ATTACHMENT_ID').AsString,
662 mtConfirmation,[mbYes,mbNo],0) = mrYes then
663 AttachSource.DataSet.Delete;
664 end;
665
666 procedure TMainForm.DisconnectAttachmentUpdate(Sender: TObject);
667 begin
668 with AttachSource.DataSet do
669 (Sender as TAction).Enabled := Active and (RecordCount > 0)
670 and (FieldByName('MON$ATTACHMENT_ID').AsInteger <>
671 AttmtSource.DataSet.FieldByName('MON$ATTACHMENT_ID').AsInteger);
672 end;
673
674 procedure TMainForm.DropDatabaseExecute(Sender: TObject);
675 begin
676 if MessageDlg(Format('Do you really want to delete the database "%s". You will lose all your data!',
677 [IBDatabaseInfo.Database.DatabaseName]),mtConfirmation,[mbYes,mbNo],0) = mrYes then
678 begin
679 DatabaseData.DropDatabase;
680 DatabaseData.Connect;
681 if not IBDatabaseInfo.Database.Connected then Close;
682 end;
683 end;
684
685 procedure TMainForm.DropDatabaseUpdate(Sender: TObject);
686 begin
687 (Sender as TAction).Enabled := IBDatabaseInfo.Database.Connected;
688 end;
689
690 procedure TMainForm.AccessRightsTreeViewSelectionChanged(Sender: TObject);
691 begin
692 if SubjectAccessRightsSource.DataSet = nil then Exit;
693 if AccessRightsSource.DataSet.Active then
694 begin
695 if (AccessRightsTreeView.Selected = nil) or (AccessRightsTreeView.Selected.Parent = nil) then
696 SubjectAccessRightsSource.DataSet.Active := false
697 else
698 DatabaseData.SyncSubjectAccessRights(TIBTreeNode(AccessRightsTreeView.Selected).KeyValue);
699 end;
700 end;
701
702 procedure TMainForm.FormClose(Sender: TObject; var CloseAction: TCloseAction);
703 begin
704 DatabaseData.Disconnect;
705 end;
706
707 procedure TMainForm.MappingsTabHide(Sender: TObject);
708 begin
709 AuthMapSource.DataSet.Active := false;
710 end;
711
712 procedure TMainForm.MappingsTabShow(Sender: TObject);
713 begin
714 if not Visible or not IBDatabaseInfo.Database.Connected then Exit;
715 AuthMapSource.DataSet.Active := IBDatabaseInfo.ODSMajorVersion > 11;
716 end;
717
718 procedure TMainForm.PageBuffersEditingDone(Sender: TObject);
719 begin
720 DatabaseData.PageBuffers := StrToInt(PageBuffers.Text);
721 end;
722
723 procedure TMainForm.QuitExecute(Sender: TObject);
724 begin
725 Close;
726 end;
727
728 procedure TMainForm.RepairTabHide(Sender: TObject);
729 begin
730 DBTablesSource.DataSet.Active := false;
731 end;
732
733 procedure TMainForm.RepairTabShow(Sender: TObject);
734 begin
735 if not Visible or not IBDatabaseInfo.Database.Connected then Exit;
736 SelectRepairActionCloseUp(nil);
737 ValidateOptions.ActivePage := ValidateOptionsTab;
738 end;
739
740 procedure TMainForm.RevokeAllExecute(Sender: TObject);
741 begin
742 if MessageDlg('Revoke all Access Rights from User ' + Trim(AccessRightsTreeView.Selected.Text),
743 mtConfirmation,[mbYes,mbNo],0) = mrYes then
744 DatabaseData.RevokeAll;
745 end;
746
747 procedure TMainForm.RevokeAllUpdate(Sender: TObject);
748 begin
749 with AccessRightsSource.DataSet do
750 (Sender as TAction).Enabled := Active and (RecordCount > 0) and
751 (FieldByName('SUBJECT_TYPE').AsInteger = 8);
752 end;
753
754 procedure TMainForm.RunScriptExecute(Sender: TObject);
755 begin
756 ExecuteSQLScriptDlg.ShowModal;
757 end;
758
759 procedure TMainForm.SelectAllTablesChange(Sender: TObject);
760 var aBookmark: TBookmark;
761 begin
762 with DBTablesSource.DataSet do
763 if Active then
764 begin
765 aBookmark := Bookmark;
766 DisableControls;
767 try
768 First;
769 while not EOF do
770 begin
771 Edit;
772 if SelectAllTables.Checked then
773 FieldByName('Selected').AsInteger := 1
774 else
775 FieldByName('Selected').AsInteger := 0;
776 Post;
777 Next;
778 end;
779 finally
780 Bookmark := aBookmark;
781 EnableControls;
782 end;
783 end;
784 end;
785
786 procedure TMainForm.SelectedTablesOnlyChange(Sender: TObject);
787 begin
788 SelectedTablesGrid.Enabled := SelectedTablesOnly.Checked;
789 SelectAllTables.Enabled := SelectedTablesOnly.Checked;
790 end;
791
792 procedure TMainForm.SelectRepairActionCloseUp(Sender: TObject);
793 begin
794 if (SelectRepairAction.ItemIndex = 1) and (IBDatabaseInfo.ODSMajorVersion < 12) then
795 begin
796 MessageDlg('Online validation is not support by Firebird prior to release 3',
797 mtError,[mbOK],0);
798 SelectRepairAction.ItemIndex := 2;
799 end;
800 ValidateOptions.Enabled := SelectRepairAction.ItemIndex = 2;
801 ConfigureOnlineValidation;
802 end;
803
804 procedure TMainForm.SubjectAccessRightsSourceDataChange(Sender: TObject;
805 Field: TField);
806 begin
807 if (Field = nil) and (not (Sender as TDataSource).Dataset.FieldByName('UPDATE_COLUMNS').IsNull or
808 not (Sender as TDataSource).Dataset.FieldByName('REFERENCE_COLUMNS').IsNull) then
809 SubjectAccessRightsGrid.ShowEditorPanel;
810 end;
811
812 procedure TMainForm.UserManagerTabHide(Sender: TObject);
813 begin
814 UserListSource.DataSet.Active := PageControl1.ActivePage = AccessRightsTab;
815 end;
816
817 procedure TMainForm.UserManagerTabShow(Sender: TObject);
818 begin
819 if not Visible or not IBDatabaseInfo.Database.Connected or DatabaseData.EmbeddedMode then Exit;
820 UserListSource.DataSet.Active := true;
821 end;
822
823 procedure TMainForm.FilesTabShow(Sender: TObject);
824 begin
825 if not Visible or not IBDatabaseInfo.Database.Connected then Exit;
826 PrimaryDBFile.Text := IBDatabaseInfo.DBFileName;
827 SecDBFilesSource.DataSet.Active := true;
828 ShadowSource.DataSet.Active := true;
829 end;
830
831 procedure TMainForm.OpenDatabaseExecute(Sender: TObject);
832 begin
833 PageControl1.ActivePage := Properties;
834 DatabaseData.Connect;
835 if not IBDatabaseInfo.Database.Connected then Close;
836 end;
837
838 procedure TMainForm.PropertiesShow(Sender: TObject);
839 begin
840 if Visible and IBDatabaseInfo.Database.Connected then
841 LoadData;
842 end;
843
844 procedure TMainForm.RemoveShadowExecute(Sender: TObject);
845 var ShadowSet: integer;
846 begin
847 ShadowSet := ShadowSource.DataSet.FieldByName('RDB$Shadow_Number').AsInteger;
848 DatabaseData.RemoveShadowSet(ShadowSet);
849 end;
850
851 procedure TMainForm.RemoveShadowUpdate(Sender: TObject);
852 begin
853 (Sender as TAction).Enabled := ShadowSource.DataSet.Active and (ShadowSource.DataSet.RecordCount > 0);
854 end;
855
856 procedure TMainForm.RestoreExecute(Sender: TObject);
857 begin
858 DatabaseData.RestoreDatabase;
859 end;
860
861 procedure TMainForm.RollbackAllExecute(Sender: TObject);
862 begin
863 DatabaseData.LimboResolution(RollbackGlobal,LimboReport.Lines);
864 end;
865
866 procedure TMainForm.RunRepairExecute(Sender: TObject);
867 var Options: TValidateOptions;
868 begin
869 ValidationReport.Lines.Clear;
870 case SelectRepairAction.ItemIndex of
871 0: {sweep}
872 Options := [SweepDB];
873 1: {Online Validation }
874 begin
875 DatabaseData.OnlineValidation(ValidationReport.Lines,SelectedTablesOnly.Checked);
876 Exit;
877 end;
878 2: {Full Validation}
879 if ValidateOptions.ActivePage = ValidateOptionsTab then
880 begin
881 Options := [ValidateDB];
882 if RecordFragments.Checked then
883 Options += [ValidateFull];
884 if ReadOnlyValidation.Checked then
885 Options += [CheckDB];
886 if IgnoreChecksums.Checked then
887 Options += [IgnoreChecksum];
888 end
889 else
890 begin
891 Options := [MendDB];
892 if ValidateRepairRecordFragments.Checked then
893 Options += [ValidateFull];
894 if IgnoreChecksumsOnRepair.Checked then
895 Options += [IgnoreChecksum];
896 end;
897 3: {Kill Shadows}
898 Options := [KillShadows];
899 end;
900
901 DatabaseData.DatabaseRepair(Options,ValidationReport.Lines);
902 if (SelectRepairAction.ItemIndex = 2) and (ValidateDB in Options) then
903 ValidateOptions.ActivePage := RepairOptionsTab
904 else
905 ValidateOptions.ActivePage := ValidateOptionsTab;
906 end;
907
908 procedure TMainForm.SaveChangesExecute(Sender: TObject);
909 begin
910 if UserTagsSource.DataSet.State in [dsEdit,dsInsert] then
911 UserTagsSource.DataSet.Post;
912 if RoleSource.DataSet.State in [dsEdit,dsInsert] then
913 RoleSource.DataSet.Post;
914 if UserListSource.DataSet.State in [dsEdit,dsInsert] then
915 UserListSource.DataSet.Post;
916 end;
917
918 procedure TMainForm.SaveChangesUpdate(Sender: TObject);
919 begin
920 (Sender as TAction).Enabled := (UserListSource.DataSet.State in [dsInsert,dsEdit]) or
921 (RoleSource.DataSet.State in [dsInsert,dsEdit]) or
922 (UserTagsSource.DataSet.State in [dsInsert,dsEdit]) ;
923 end;
924
925 procedure TMainForm.SaveExecute(Sender: TObject);
926 begin
927 if PageControl1.ActivePage = SchemaTab then
928 begin
929 if SQLSaveDialog.Execute then
930 SynEdit1.Lines.SaveToFile(SQLSaveDialog.FileName);
931 end
932 else
933 if PageControl1.ActivePage = StatisticsTab then
934 begin
935 if SaveDialog.Execute then
936 StatsMemo.Lines.SaveToFile(SaveDialog.FileName);
937 end;
938 end;
939
940 procedure TMainForm.SaveUpdate(Sender: TObject);
941 begin
942 (Sender as TAction).Enabled := (PageControl1.ActivePage = SchemaTab) or
943 (PageControl1.ActivePage = StatisticsTab);
944 end;
945
946 procedure TMainForm.SchemaTabShow(Sender: TObject);
947 begin
948 if not Visible or not IBDatabaseInfo.Database.Connected then Exit;
949 SynEdit1.Lines.Clear;
950 Application.QueueAsyncCall(@DoExtract,0);
951 end;
952
953 procedure TMainForm.ServerTabHide(Sender: TObject);
954 begin
955 FServerError := false;
956 end;
957
958 procedure TMainForm.ServerTabShow(Sender: TObject);
959 begin
960 if not Visible or not IBDatabaseInfo.Database.Connected or FServerError then Exit;
961 try
962 DatabaseData.LoadServerProperties(ServerPropMemo.Lines);
963 DatabaseData.LoadServerLog(ServerLog.Lines);
964 except
965 FServerError := true;
966 ServerPropMemo.Lines.Clear;
967 ServerLog.Lines.Clear;
968 raise;
969 end;
970 end;
971
972 procedure TMainForm.StatisticsTabHide(Sender: TObject);
973 begin
974 FLastStatsIndex := -1;
975 end;
976
977 procedure TMainForm.StatisticsTabShow(Sender: TObject);
978 begin
979 if not Visible or not IBDatabaseInfo.Database.Connected then Exit;
980 if FLastStatsIndex <> StatsOptions.ItemIndex then {avoids loops if exception raise in load stats}
981 StatsOptionsCloseUp(nil);
982 end;
983
984 procedure TMainForm.StatsOptionsCloseUp(Sender: TObject);
985 begin
986 StatsMemo.Lines.Clear;
987 FLastStatsIndex := StatsOptions.ItemIndex;
988 DatabaseData.LoadDatabaseStatistics(StatsOptions.ItemIndex,StatsMemo.Lines);
989 end;
990
991 procedure TMainForm.SweepIntervalEditingDone(Sender: TObject);
992 begin
993 if FLoading then Exit;
994 DatabaseData.SweepInterval := StrtoInt(SweepInterval.Text);
995 end;
996
997 procedure TMainForm.SyncWritesChange(Sender: TObject);
998 begin
999 if FLoading then Exit;
1000 DatabaseData.ForcedWrites := SyncWrites.Checked;
1001 end;
1002
1003 procedure TMainForm.ToggleAutoRefreshExecute(Sender: TObject);
1004 begin
1005 AttmtTimer.Enabled := not AttmtTimer.Enabled;
1006 end;
1007
1008 procedure TMainForm.ToggleAutoRefreshUpdate(Sender: TObject);
1009 begin
1010 (Sender as TAction).Enabled := AttachSource.DataSet.Active;
1011 (Sender as TAction).Checked := AttmtTimer.Enabled;
1012 end;
1013
1014 procedure TMainForm.HandleDBConnect(Sender: TObject);
1015 begin
1016 ConfigureForServerVersion;
1017 PageControl1.ActivePage := Properties;
1018 ValidationReport.Lines.Clear;
1019 LimboReport.Lines.Clear;
1020 FLastStatsIndex := -1;
1021 end;
1022
1023 procedure TMainForm.HandleLoadData(Sender: TObject);
1024 begin
1025 if DatabaseData.EmbeddedMode then
1026 StatusBar1.SimpleText := Format('Database: %s - Logged in as user %s in embedded mode',
1027 [DatabaseData.IBDatabase1.DatabaseName,DatabaseData.IBDatabase1.Params.Values['user_name']
1028 ])
1029 else
1030 if DatabaseData.DBUserName = 'SYSDBA' then
1031 StatusBar1.SimpleText := Format('Database: %s - Logged in as user %s by %s, using %s security database.',
1032 [DatabaseData.IBDatabase1.DatabaseName,DatabaseData.DBUserName,
1033 DatabaseData.AuthMethod, DatabaseData.SecurityDatabase])
1034 else
1035 StatusBar1.SimpleText := Format('Database: %s - Logged in as user %s by %s, using %s security database. Role = %s',
1036 [DatabaseData.IBDatabase1.DatabaseName,DatabaseData.DBUserName,
1037 DatabaseData.AuthMethod, DatabaseData.SecurityDatabase,DatabaseData.RoleName]);
1038 if assigned(PageControl1.ActivePage.OnShow) then
1039 PageControl1.ActivePage.OnShow(nil);
1040 ClientLibrary.Caption := 'Firebird Client Library: ' + DatabaseData.IBDatabase1.FirebirdAPI.GetFBLibrary.GetLibraryFilePath +
1041 ' (API Version = ' + DatabaseData.IBDatabase1.FirebirdAPI.GetImplementationVersion + ')';
1042 end;
1043
1044 procedure TMainForm.LoadData;
1045 begin
1046 if FLoading then Exit;
1047 FLoading := true;
1048 try
1049 DatabaseAliasName.Text := DatabaseData.DatabaseName;
1050 Edit1.Text := IBDatabaseInfo.DBSiteName;
1051 ODSVersionString.Text := Format('%d.%d',[IBDatabaseInfo.ODSMajorVersion,IBDatabaseInfo.ODSMinorVersion]);
1052 ServerVersionNo.Text := IBDatabaseInfo.Version;
1053 DBSQLDialect.Text := IntToStr(DatabaseData.DBSQLDialect);
1054 ConnectString.Text := DatabaseData.IBDatabase1.DatabaseName;
1055 Edit10.Text := IntToStr(IBDatabaseInfo.CurrentMemory);
1056 Edit11.Text := IntToStr(IBDatabaseInfo.MaxMemory);
1057 PageBuffers.Text := IntToStr(DatabaseData.PageBuffers);
1058 AllocatedPages.Text := IntToStr(IBDatabaseInfo.Allocation);
1059 DBIsReadOnly.Checked := DatabaseData.DBReadOnly;
1060 SyncWrites.Checked := DatabaseData.ForcedWrites;
1061 SweepInterval.Text := IntToStr(IBDatabaseInfo.SweepInterval);
1062 NoReserve.Checked := DatabaseData.NoReserve;
1063 LingerDelay.Text := DatabaseData.LingerDelay;
1064 SecDatabase.Text := DatabaseData.SecurityDatabase;
1065 DBOwner.Text := DatabaseData.DBOwner;
1066 DatabaseOnline.Checked := DatabaseData.IsDatabaseOnline;
1067 IsShadowChk.Checked := DatabaseData.IsShadowDatabase;
1068 if IBDatabaseInfo.ODSMajorVersion >= 12 then
1069 begin
1070 PagesUsed.Text := IntToStr(IBDatabaseInfo.PagesUsed);
1071 PagesAvail.Text := IntToStr(IBDatabaseInfo.PagesFree);
1072 AutoAdmin.Checked := not DatabaseData.EmbeddedMode and DatabaseData.AutoAdmin;
1073 end
1074 else
1075 begin
1076 PagesUsed.Text := 'n/a';
1077 PagesAvail.Text := 'n/a';
1078 AutoAdmin.Checked := false;
1079 end;
1080 DBComments.Lines.Text := DatabaseData.Description;
1081 finally
1082 FLoading := false;
1083 end;
1084 end;
1085
1086 procedure TMainForm.DoExtract(Data: PtrInt);
1087 begin
1088 Screen.Cursor := crHourGlass;
1089 try
1090 Application.ProcessMessages;
1091 if IncludeUserGrants.Checked then
1092 IBExtract1.ExtractObject(eoDatabase,'',[etGrantsToUser])
1093 else
1094 IBExtract1.ExtractObject(eoDatabase);
1095 SynEdit1.Lines.Assign(IBExtract1.Items);
1096 finally
1097 Screen.Cursor := crDefault;
1098 end;
1099 end;
1100
1101 procedure TMainForm.ConfigureForServerVersion;
1102 var i: integer;
1103 begin
1104 if (IBDatabaseInfo.ODSMajorVersion >= 12) and
1105 ((DatabaseData.DBUserName = 'SYSDBA') or (DatabaseData.RoleName = 'RDB$ADMIN') or
1106 not DatabaseData.HasUserAdminPrivilege) then
1107 begin
1108 for i in [9,10] do
1109 UserManagerGrid.Columns[i].Visible := false;
1110 for i in [4,6,7,8] do
1111 UserManagerGrid.Columns[i].Visible := true ;
1112 UserListSource.DataSet := DatabaseData.UserList;
1113 TagsHeader.Visible := true;
1114 TagsGrid.Visible := true;
1115 end
1116 else
1117 begin
1118 for i in [4,6,7,8] do
1119 UserManagerGrid.Columns[i].Visible := false;
1120 for i in [9,10] do
1121 UserManagerGrid.Columns[i].Visible := true;
1122 UserListSource.DataSet := DatabaseData.LegacyUserList;
1123 TagsHeader.Visible := false;
1124 TagsGrid.Visible := false;
1125 end;
1126
1127 if IBDatabaseInfo.ODSMajorVersion >= 12 then
1128 begin
1129 AttmtGrid.Columns[2].Visible := true;
1130 AttmntODS12Panel.Visible := true;
1131 DBCharacterSet.Visible := true;
1132 DBCharSetRO.Visible := false;
1133 end
1134 else
1135 begin
1136 AttmtGrid.Columns[2].Visible := false;
1137 AttmntODS12Panel.Visible := false;
1138 DBCharacterSet.Visible := false;
1139 DBCharSetRO.Visible := true;
1140 end;
1141 MappingsTab.TabVisible := not DatabaseData.EmbeddedMode and
1142 ((IBDatabaseInfo.ODSMajorVersion > 11) or
1143 ((IBDatabaseInfo.ODSMajorVersion = 11) and (IBDatabaseInfo.ODSMinorVersion > 0)));
1144 UserManagerTab.TabVisible := not DatabaseData.EmbeddedMode;
1145 AccessRightsTab.TabVisible := not DatabaseData.EmbeddedMode;
1146 AutoAdmin.Enabled := not DatabaseData.EmbeddedMode;
1147 end;
1148
1149 procedure TMainForm.ConfigureOnlineValidation;
1150 begin
1151 if SelectRepairAction.ItemIndex = 1 then
1152 begin
1153 DBTablesPanel.Visible := true;
1154 DBTablesSplitter.Visible := true;
1155 SelectedTablesGrid.Enabled := SelectedTablesOnly.Checked;
1156 SelectAllTables.Checked := true;
1157 DBTablesSource.DataSet.Active := true;
1158 end
1159 else
1160 begin
1161 DBTablesPanel.Visible := false;
1162 DBTablesSplitter.Visible := false;
1163 SelectAllTables.Enabled := false;
1164 DBTablesSource.DataSet.Active := false;
1165 end;
1166 end;
1167
1168 end.
1169