1 |
(*
|
2 |
* AddShadowSetDlgUnit.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 AddShadowSetDlgUnit;
|
19 |
|
20 |
{$mode objfpc}{$H+}
|
21 |
|
22 |
interface
|
23 |
|
24 |
uses
|
25 |
Classes, SysUtils, FileUtil, Controls,
|
26 |
ExtCtrls, StdCtrls, ActnList, memds, db, IBDatabase, IBSQL, IBDatabaseInfo,
|
27 |
IBDynamicGrid, Forms, Dialogs, DbCtrls, ComCtrls, IB;
|
28 |
|
29 |
type
|
30 |
|
31 |
{ TAddShadowSetDlg }
|
32 |
|
33 |
TAddShadowSetDlg = class(TForm)
|
34 |
Add: TAction;
|
35 |
Bevel1: TBevel;
|
36 |
CancelBtn: TButton;
|
37 |
Creating: TLabel;
|
38 |
ExecSQL: TIBSQL;
|
39 |
IBDatabaseInfo: TIBDatabaseInfo;
|
40 |
OKBtn: TButton;
|
41 |
ProgressBar: TProgressBar;
|
42 |
Remove: TAction;
|
43 |
ActionList1: TActionList;
|
44 |
Button1: TButton;
|
45 |
ShadowFileSource: TDataSource;
|
46 |
IBDynamicGrid1: TIBDynamicGrid;
|
47 |
Label1: TLabel;
|
48 |
Label2: TLabel;
|
49 |
ShadowFileList: TMemDataset;
|
50 |
RemoveBtn: TButton;
|
51 |
ShadowMode: TRadioGroup;
|
52 |
ShadowSet: TEdit;
|
53 |
WaitTimer: TTimer;
|
54 |
procedure AddExecute(Sender: TObject);
|
55 |
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
56 |
procedure FormShow(Sender: TObject);
|
57 |
procedure RemoveExecute(Sender: TObject);
|
58 |
procedure RemoveUpdate(Sender: TObject);
|
59 |
procedure ShadowFileListBeforeClose(DataSet: TDataSet);
|
60 |
procedure ShadowSetEditingDone(Sender: TObject);
|
61 |
procedure WaitTimerTimer(Sender: TObject);
|
62 |
private
|
63 |
FShadowSet: integer;
|
64 |
FShadowThread: TThread;
|
65 |
public
|
66 |
function ShowModal( aShadowSet: integer): TModalResult;
|
67 |
end;
|
68 |
|
69 |
var
|
70 |
AddShadowSetDlg: TAddShadowSetDlg;
|
71 |
|
72 |
implementation
|
73 |
|
74 |
uses AddShadowFileDlgUnit;
|
75 |
|
76 |
{$R *.lfm}
|
77 |
|
78 |
const
|
79 |
sCreateShadow = 'Create Shadow %d %s ''%s''';
|
80 |
sCreateFirstShadow = 'Create Shadow %d %s ''%s'' LENGTH %d';
|
81 |
sNextShadow = 'FILE ''%s'' LENGTH %d';
|
82 |
sCreateLastShadow = 'FILE ''%s'' STARTING AT %d';
|
83 |
|
84 |
resourcestring
|
85 |
sLengthIgnored = 'The Length is ignore for the last or only file in the Shadow Set';
|
86 |
sNoLength = 'A Length must be specified for all but the last file in a multi-file set';
|
87 |
|
88 |
type
|
89 |
|
90 |
{ TCreateShadowThread }
|
91 |
|
92 |
TCreateShadowThread = class(TThread)
|
93 |
private
|
94 |
FOwner: TAddShadowSetDlg;
|
95 |
FSQLText: string;
|
96 |
FErrorMessage: string;
|
97 |
protected
|
98 |
procedure Execute; override;
|
99 |
public
|
100 |
constructor Create(aOwner: TAddShadowSetDlg; SQLText: string);
|
101 |
property ErrorMessage: string read FErrorMessage;
|
102 |
end;
|
103 |
|
104 |
{ TCreateShadowThread }
|
105 |
|
106 |
procedure TCreateShadowThread.Execute;
|
107 |
begin
|
108 |
FErrorMessage := '';
|
109 |
try
|
110 |
with FOwner.ExecSQL do
|
111 |
begin
|
112 |
Transaction.Active := true;
|
113 |
SQL.Text := FSQLText;
|
114 |
ExecQuery;
|
115 |
Transaction.Commit;
|
116 |
end;
|
117 |
except On E:Exception do
|
118 |
FErrorMessage := E.Message;
|
119 |
end;
|
120 |
end;
|
121 |
|
122 |
constructor TCreateShadowThread.Create(aOwner: TAddShadowSetDlg; SQLText: string
|
123 |
);
|
124 |
begin
|
125 |
inherited Create(false);
|
126 |
FOwner := aOwner;
|
127 |
FErrorMessage := '';
|
128 |
FSQLText := SQLText;
|
129 |
end;
|
130 |
|
131 |
|
132 |
|
133 |
{ TAddShadowSetDlg }
|
134 |
|
135 |
procedure TAddShadowSetDlg.FormClose(Sender: TObject;
|
136 |
var CloseAction: TCloseAction);
|
137 |
var SQLText: string;
|
138 |
Mode: string;
|
139 |
StartAt: integer;
|
140 |
FileName: string;
|
141 |
FileLength: integer;
|
142 |
begin
|
143 |
if ModalResult = mrYes then
|
144 |
begin
|
145 |
ShadowFileList.DisableControls;
|
146 |
ShadowFileList.Last;
|
147 |
if not ShadowFileList.FieldByName('ShadowFileLength').IsNull then
|
148 |
begin
|
149 |
MessageDlg(sLengthIgnored,mtWarning,[mbOK],0);
|
150 |
CloseAction := caNone;
|
151 |
Exit;
|
152 |
end;
|
153 |
|
154 |
ShadowFileList.First;
|
155 |
case ShadowMode.ItemIndex of
|
156 |
0: Mode := 'AUTO';
|
157 |
1: Mode := 'MANUAL';
|
158 |
2: Mode := 'CONDITIONAL';
|
159 |
end;
|
160 |
if ShadowFileList.RecordCount = 1 then
|
161 |
SQLText := Format(sCreateShadow,[FShadowSet,Mode,ShadowFileList.FieldByName('ShadowFileName').AsString])
|
162 |
else
|
163 |
begin
|
164 |
if ShadowFileList.FieldByName('ShadowFileLength').AsInteger = 0 then
|
165 |
begin
|
166 |
MessageDlg(sNoLength,mtError,[mbOK],0);
|
167 |
CloseAction := caNone;
|
168 |
Exit;
|
169 |
end;
|
170 |
SQLText := Format(sCreateFirstShadow,[FShadowSet,Mode,
|
171 |
ShadowFileList.FieldByName('ShadowFileName').AsString,
|
172 |
ShadowFileList.FieldByName('ShadowFileLength').AsInteger]);
|
173 |
StartAt := ShadowFileList.FieldByName('ShadowFileLength').AsInteger;
|
174 |
ShadowFileList.Next;
|
175 |
while not ShadowFileList.EOF do
|
176 |
begin
|
177 |
FileName := ShadowFileList.FieldByName('ShadowFileName').AsString;
|
178 |
FileLength := ShadowFileList.FieldByName('ShadowFileLength').AsInteger;
|
179 |
ShadowFileList.Next;
|
180 |
if ShadowFileList.EOF then
|
181 |
SQLText := SQLText + ' ' + Format(sCreateLastShadow,[FileName,StartAt+1])
|
182 |
else
|
183 |
begin
|
184 |
if FileLength = 0 then
|
185 |
begin
|
186 |
MessageDlg(sNoLength,mtError,[mbOK],0);
|
187 |
CloseAction := caNone;
|
188 |
Exit;
|
189 |
end;
|
190 |
Inc(StartAt,FileLength);
|
191 |
SQLText := SQLText + ' ' + Format(sNextShadow,[FileName,FileLength]);
|
192 |
end;
|
193 |
end;
|
194 |
end;
|
195 |
Creating.Visible := true;
|
196 |
ProgressBar.Visible := true;
|
197 |
Application.ProcessMessages;
|
198 |
// writeln(SQLText);
|
199 |
FShadowThread := TCreateShadowThread.Create(self,SQLText);
|
200 |
WaitTimer.Enabled := true;
|
201 |
CloseAction := caNone;
|
202 |
end;
|
203 |
end;
|
204 |
|
205 |
procedure TAddShadowSetDlg.FormShow(Sender: TObject);
|
206 |
begin
|
207 |
Creating.Visible := false;
|
208 |
ProgressBar.Visible := false;
|
209 |
ShadowFileList.Clear(false);
|
210 |
end;
|
211 |
|
212 |
procedure TAddShadowSetDlg.AddExecute(Sender: TObject);
|
213 |
var aFileName: string;
|
214 |
aFileLength: integer;
|
215 |
Pages: boolean;
|
216 |
begin
|
217 |
if AddShadowFileDlg.ShowModal(aFileName,aFileLength,Pages) = mrOK then
|
218 |
begin
|
219 |
if not Pages then
|
220 |
begin
|
221 |
if aFileLength <> -1 then
|
222 |
aFileLength := aFileLength*1024*1024 div IBDatabaseInfo.PageSize;
|
223 |
end;
|
224 |
with ShadowFileList do
|
225 |
begin
|
226 |
Append;
|
227 |
FieldByName('ShadowFileName').AsString := aFileName;
|
228 |
if aFileLength <> -1 then
|
229 |
FieldByName('ShadowFileLength').AsInteger := aFileLength;
|
230 |
Post;
|
231 |
end;
|
232 |
end;
|
233 |
end;
|
234 |
|
235 |
procedure TAddShadowSetDlg.RemoveExecute(Sender: TObject);
|
236 |
begin
|
237 |
ShadowFileList.Delete;
|
238 |
end;
|
239 |
|
240 |
procedure TAddShadowSetDlg.RemoveUpdate(Sender: TObject);
|
241 |
begin
|
242 |
(Sender as TAction).Enabled := ShadowFileList.Active and (ShadowFileList.RecordCount > 0);
|
243 |
end;
|
244 |
|
245 |
procedure TAddShadowSetDlg.ShadowFileListBeforeClose(DataSet: TDataSet);
|
246 |
begin
|
247 |
ShadowFileList.Clear(false);
|
248 |
end;
|
249 |
|
250 |
procedure TAddShadowSetDlg.ShadowSetEditingDone(Sender: TObject);
|
251 |
begin
|
252 |
FShadowSet := StrToInt(ShadowSet.Text);
|
253 |
end;
|
254 |
|
255 |
procedure TAddShadowSetDlg.WaitTimerTimer(Sender: TObject);
|
256 |
begin
|
257 |
with TCreateShadowThread(FShadowThread) do
|
258 |
begin
|
259 |
if Finished then
|
260 |
begin
|
261 |
if ErrorMessage <> '' then
|
262 |
begin
|
263 |
MessageDlg(ErrorMessage,mtError,[mbOK],0);
|
264 |
ModalResult := mrCancel;
|
265 |
end;
|
266 |
ShadowFileList.EnableControls;
|
267 |
WaitTimer.Enabled := false;
|
268 |
ModalResult := mrOK;
|
269 |
Free;
|
270 |
end;
|
271 |
end;
|
272 |
end;
|
273 |
|
274 |
function TAddShadowSetDlg.ShowModal(aShadowSet: integer): TModalResult;
|
275 |
begin
|
276 |
FShadowSet := aShadowSet;
|
277 |
ShadowSet.Text := IntToStr(aShadowSet);
|
278 |
Result := inherited ShowModal;
|
279 |
end;
|
280 |
|
281 |
|
282 |
end.
|
283 |
|