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