ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/examples/DBAdmin/MainFormUnit.pas
Revision: 231
Committed: Mon Apr 16 08:32:21 2018 UTC (6 years ago) by tony
Content type: text/x-pascal
File size: 35614 byte(s)
Log Message:
Fixes merged

File Contents

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