ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/examples/DBAdmin/MainFormUnit.pas
Revision: 229
Committed: Tue Apr 10 13:32:36 2018 UTC (6 years ago) by tony
Content type: text/x-pascal
File size: 35302 byte(s)
Log Message:
Fixes Merged

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