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