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