ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/examples/DBAdmin/MainFormUnit.pas
Revision: 158
Committed: Thu Mar 1 11:23:33 2018 UTC (6 years, 1 month ago) by tony
Content type: text/x-pascal
File size: 34252 byte(s)
Log Message: 
Repository resync

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