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

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, IBServices;
27
28 type
29
30 { TBackupDlg }
31
32 TBackupDlg = class(TForm)
33 Button1: TButton;
34 Button2: TButton;
35 NoDBTriggers: TCheckBox;
36 NoGarbageCollection: TCheckBox;
37 MetadataOnly: TCheckBox;
38 IgnoreLimboTransactions: TCheckBox;
39 IgnoreChecksums: TCheckBox;
40 Edit1: TEdit;
41 Edit2: TEdit;
42 Edit3: TEdit;
43 IBBackupService1: TIBBackupService;
44 Label1: TLabel;
45 Label2: TLabel;
46 Label3: TLabel;
47 Report: TMemo;
48 PageControl1: TPageControl;
49 RadioButton1: TRadioButton;
50 RadioButton2: TRadioButton;
51 SaveDialog1: TSaveDialog;
52 SpeedButton1: TSpeedButton;
53 SelectTab: TTabSheet;
54 ReportTab: TTabSheet;
55 procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
56 procedure FormShow(Sender: TObject);
57 procedure ReportTabShow(Sender: TObject);
58 procedure SpeedButton1Click(Sender: TObject);
59 private
60 { private declarations }
61 procedure DoBackup(Data: PtrInt);
62 public
63 { public declarations }
64 end;
65
66 var
67 BackupDlg: TBackupDlg;
68
69 implementation
70
71 {$R *.lfm}
72
73 { TBackupDlg }
74
75 procedure TBackupDlg.SpeedButton1Click(Sender: TObject);
76 begin
77 if SaveDialog1.Execute then
78 Edit3.Text := SaveDialog1.Filename;
79 end;
80
81 procedure TBackupDlg.DoBackup(Data: PtrInt);
82 var bakfile: TFileStream;
83 BackupCount: integer;
84 begin
85 bakfile := nil;
86 with IBBackupService1 do
87 begin
88 Options := [];
89 if IgnoreChecksums.Checked then
90 Options := Options + [IBServices.IgnoreChecksums];
91 if IgnoreLimboTransactions.Checked then
92 Options := Options + [IgnoreLimbo];
93 if MetadataOnly.Checked then
94 Options := Options + [IBServices.MetadataOnly];
95 if NoGarbageCollection.Checked then
96 Options := Options + [IBServices.NoGarbageCollection];
97 if NoDBTriggers.Checked then
98 Options := Options + [IBServices.NoDBTriggers];
99 end;
100
101 Report.Lines.Add('Starting Backup');
102 if IBBackupService1.BackupFileLocation = flClientSide then
103 bakfile := TFileStream.Create(IBBackupService1.BackupFile[0],fmCreate);
104 try
105 IBBackupService1.ServiceStart;
106 while not IBBackupService1.Eof do
107 begin
108 case IBBackupService1.BackupFileLocation of
109 flServerSide:
110 Report.Lines.Add(IBBackupService1.GetNextLine);
111 flClientSide:
112 IBBackupService1.WriteNextChunk(bakfile);
113 end;
114 Application.ProcessMessages;
115 end;
116 if bakfile <> nil then
117 BackupCount := bakfile.Size;
118 finally
119 if bakfile <> nil then
120 bakfile.Free;
121 end;
122
123 while IBBackupService1.IsServiceRunning do; {flush}
124
125 {Report completion}
126 case IBBackupService1.BackupFileLocation of
127 flServerSide:
128 begin
129 Report.Lines.Add('Backup Completed');
130 MessageDlg('Backup Completed',mtInformation,[mbOK],0);
131 end;
132 flClientSide:
133 begin
134 Report.Lines.Add(Format('Backup Completed - File Size = %d bytes',[BackupCount]));
135 MessageDlg(Format('Backup Completed - File Size = %d bytes',[BackupCount]),mtInformation,[mbOK],0);
136 end;
137 end;
138 IBBackupService1.Active := false;
139 end;
140
141 procedure TBackupDlg.FormShow(Sender: TObject);
142 begin
143 PageControl1.ActivePage := SelectTab;
144 Edit1.Text := IBBackupService1.ServerName;
145 if IBBackupService1.BackupFileLocation = flServerSide then
146 RadioButton1.Checked := true
147 else
148 RadioButton2.Checked := true;
149 Edit2.Text := IBBackupService1.DatabaseName;
150 IBBackupService1.BackupFile.Clear;
151 end;
152
153 procedure TBackupDlg.ReportTabShow(Sender: TObject);
154 begin
155 Report.Lines.Clear;
156 end;
157
158 procedure TBackupDlg.FormClose(Sender: TObject; var CloseAction: TCloseAction);
159 begin
160 if ModalResult <> mrOK then Exit;
161
162 if PageControl1.ActivePage = SelectTab then
163 begin
164 CloseAction := caNone;
165 if Edit3.Text = '' then
166 raise Exception.Create('A Backup File Name must be given');
167 IBBackupService1.BackupFile.Add(Edit3.Text);
168 if RadioButton1.Checked then
169 IBBackupService1.BackupFileLocation := flServerSide
170 else
171 IBBackupService1.BackupFileLocation := flClientSide;
172 PageControl1.ActivePage := ReportTab;
173 Application.QueueAsyncCall(@DoBackup,0);
174 end;
175 end;
176
177 end.
178