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