ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/examples/DBAdmin/dlg/BackupDlgUnit.pas
Revision: 380
Committed: Mon Jan 10 10:13:17 2022 UTC (2 years, 2 months ago) by tony
Content type: text/x-pascal
File size: 5287 byte(s)
Log Message:
propset for eol-style

File Contents

# Content
1 (*
2 * BackupDlgUnit.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 BackupDlgUnit;
19
20 {$mode objfpc}{$H+}
21
22 interface
23
24 uses
25 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
26 Buttons, ExtCtrls, ComCtrls, IBXServices;
27
28 type
29
30 { TBackupDlg }
31
32 TBackupDlg = class(TForm)
33 Button1: TButton;
34 Button2: TButton;
35 IBXClientSideBackupService1: TIBXClientSideBackupService;
36 IBXServerSideBackupService1: TIBXServerSideBackupService;
37 NoDBTriggers: TCheckBox;
38 NoGarbageCollection: TCheckBox;
39 MetadataOnly: TCheckBox;
40 IgnoreLimboTransactions: TCheckBox;
41 IgnoreChecksums: TCheckBox;
42 ProgressBar1: TProgressBar;
43 ServerName: TEdit;
44 DBName: TEdit;
45 BackupFileName: TEdit;
46 Label1: TLabel;
47 Label2: TLabel;
48 Label3: TLabel;
49 Report: TMemo;
50 PageControl1: TPageControl;
51 ServerSideBtn: TRadioButton;
52 ClientSideBtn: TRadioButton;
53 SaveDialog1: TSaveDialog;
54 SpeedButton1: TSpeedButton;
55 SelectTab: TTabSheet;
56 ReportTab: TTabSheet;
57 procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
58 procedure FormShow(Sender: TObject);
59 procedure IBXClientSideBackupService1GetNextLine(Sender: TObject;
60 var Line: string);
61 procedure ReportTabShow(Sender: TObject);
62 procedure SpeedButton1Click(Sender: TObject);
63 private
64 { private declarations }
65 procedure DoClientBackup(Data: PtrInt);
66 procedure DoServerBackup(Data: PtrInt);
67 public
68 { public declarations }
69 end;
70
71 var
72 BackupDlg: TBackupDlg;
73
74 implementation
75
76 {$R *.lfm}
77
78 { TBackupDlg }
79
80 procedure TBackupDlg.SpeedButton1Click(Sender: TObject);
81 begin
82 if SaveDialog1.Execute then
83 BackupFileName.Text := SaveDialog1.Filename;
84 end;
85
86 procedure TBackupDlg.DoClientBackup(Data: PtrInt);
87 var BackupCount: integer;
88 begin
89 ProgressBar1.Visible := true;
90 with IBXClientSideBackupService1 do
91 begin
92 Options := [];
93 if IgnoreChecksums.Checked then
94 Options := Options + [IBXServices.IgnoreChecksums];
95 if IgnoreLimboTransactions.Checked then
96 Options := Options + [IgnoreLimbo];
97 if MetadataOnly.Checked then
98 Options := Options + [IBXServices.MetadataOnly];
99 if NoGarbageCollection.Checked then
100 Options := Options + [IBXServices.NoGarbageCollection];
101 if NoDBTriggers.Checked then
102 Options := Options + [IBXServices.NoDBTriggers];
103
104 Report.Lines.Add('Starting Backup');
105 BackupToFile(BackupFileName.Text, BackupCount);
106 end;
107 Report.Lines.Add(Format('Backup Completed - File Size = %d bytes',[BackupCount]));
108 ProgressBar1.Visible := false;
109 MessageDlg(Format('Backup Completed - File Size = %d bytes',[BackupCount]),mtInformation,[mbOK],0);
110 end;
111
112 procedure TBackupDlg.DoServerBackup(Data: PtrInt);
113 begin
114 ProgressBar1.Visible := true;
115 with IBXServerSideBackupService1 do
116 begin
117 BackupFiles.Clear;
118 BackupFiles.Add(BackupFileName.Text);
119 Options := [];
120 if IgnoreChecksums.Checked then
121 Options := Options + [IBXServices.IgnoreChecksums];
122 if IgnoreLimboTransactions.Checked then
123 Options := Options + [IgnoreLimbo];
124 if MetadataOnly.Checked then
125 Options := Options + [IBXServices.MetadataOnly];
126 if NoGarbageCollection.Checked then
127 Options := Options + [IBXServices.NoGarbageCollection];
128 if NoDBTriggers.Checked then
129 Options := Options + [IBXServices.NoDBTriggers];
130 Report.Lines.Add('Starting Backup');
131 Execute(Report.Lines);
132 Report.Lines.Add('Backup Completed');
133 ProgressBar1.Visible := false;
134 MessageDlg('Backup Completed',mtInformation,[mbOK],0);
135 end;
136 end;
137
138 procedure TBackupDlg.FormShow(Sender: TObject);
139 begin
140 PageControl1.ActivePage := SelectTab;
141 ServerName.Text := IBXClientSideBackupService1.ServicesConnection.ServerName;
142 DBName.Text := IBXClientSideBackupService1.DatabaseName;
143 BackupFileName.Text := '';
144 end;
145
146 procedure TBackupDlg.IBXClientSideBackupService1GetNextLine(Sender: TObject;
147 var Line: string);
148 begin
149 Application.ProcessMessages;
150 end;
151
152 procedure TBackupDlg.ReportTabShow(Sender: TObject);
153 begin
154 Report.Lines.Clear;
155 end;
156
157 procedure TBackupDlg.FormClose(Sender: TObject; var CloseAction: TCloseAction);
158 begin
159 if ModalResult <> mrOK then Exit;
160
161 if PageControl1.ActivePage = SelectTab then
162 begin
163 CloseAction := caNone;
164 if BackupFileName.Text = '' then
165 raise Exception.Create('A Backup File Name must be given');
166 PageControl1.ActivePage := ReportTab;
167 Application.ProcessMessages;
168 if ServerSideBtn.Checked then
169 Application.QueueAsyncCall(@DoServerBackup,0)
170 else
171 Application.QueueAsyncCall(@DoClientBackup,0);
172 end;
173 end;
174
175 end.
176

Properties

Name Value
svn:eol-style native