ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/examples/DBAdmin/MainFormUnit.pas
Revision: 158
Committed: Thu Mar 1 11:23:33 2018 UTC (6 years, 1 month ago) by tony
Content type: text/x-pascal
File size: 34252 byte(s)
Log Message:
Repository resync

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