ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/examples/DBAdmin/MainFormUnit.pas
Revision: 263
Committed: Thu Dec 6 15:55:01 2018 UTC (5 years, 4 months ago) by tony
Content type: text/x-pascal
File size: 35886 byte(s)
Log Message:
Release 2.3.2 committed

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