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

File Contents

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