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