DBAdmin/dlg/AddShadowSetDlgUnit.pas

(*
 * AddShadowSetDlgUnit.pas
 * Copyright (C) 2018 Tony Whyman <tony@mwasoftware.co.uk>
 *
 * DBAdmin is free software: you can redistribute it and/or modify it
 * under the terms of the GNU General Public License as published by the
 * Free Software Foundation, either version 3 of the License, or
 * (at your option) any later version.
 * 
 * DBAdmin is distributed in the hope that it will be useful, but
 * WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 * See the GNU General Public License for more details.
 * 
 * You should have received a copy of the GNU General Public License along
 * with this program.  If not, see <http://www.gnu.org/licenses/>.
 *)
unit AddShadowSetDlgUnit;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Controls,
  ExtCtrls, StdCtrls, ActnList, memds, db, IBDatabase, IBSQL, IBDatabaseInfo,
  IBDynamicGrid, Forms, Dialogs, DbCtrls, ComCtrls, IB;

type

  { TAddShadowSetDlg }

  TAddShadowSetDlg = class(TForm)
    Add: TAction;
    Bevel1: TBevel;
    CancelBtn: TButton;
    Creating: TLabel;
    ExecSQL: TIBSQL;
    IBDatabaseInfo: TIBDatabaseInfo;
    OKBtn: TButton;
    ProgressBar: TProgressBar;
    Remove: TAction;
    ActionList1: TActionList;
    Button1: TButton;
    ShadowFileSource: TDataSource;
    IBDynamicGrid1: TIBDynamicGrid;
    Label1: TLabel;
    Label2: TLabel;
    ShadowFileList: TMemDataset;
    RemoveBtn: TButton;
    ShadowMode: TRadioGroup;
    ShadowSet: TEdit;
    WaitTimer: TTimer;
    procedure AddExecute(Sender: TObject);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure RemoveExecute(Sender: TObject);
    procedure RemoveUpdate(Sender: TObject);
    procedure ShadowFileListBeforeClose(DataSet: TDataSet);
    procedure ShadowSetEditingDone(Sender: TObject);
    procedure WaitTimerTimer(Sender: TObject);
  private
    FShadowSet: integer;
    FShadowThread: TThread;
  public
    function ShowModal( aShadowSet: integer): TModalResult;
  end;

var
  AddShadowSetDlg: TAddShadowSetDlg;

implementation

uses AddShadowFileDlgUnit;

{$R *.lfm}

const
  sCreateShadow      = 'Create Shadow %d %s ''%s''';
  sCreateFirstShadow = 'Create Shadow %d %s ''%s'' LENGTH %d';
  sNextShadow        = 'FILE ''%s'' LENGTH %d';
  sCreateLastShadow  = 'FILE ''%s'' STARTING AT %d';

resourcestring
  sLengthIgnored = 'The Length is ignore for the last or only file in the Shadow Set';
  sNoLength = 'A Length must be specified for all but the last file in a multi-file set';

type

  { TCreateShadowThread }

  TCreateShadowThread = class(TThread)
  private
    FOwner: TAddShadowSetDlg;
    FSQLText: string;
    FErrorMessage: string;
  protected
    procedure Execute; override;
  public
    constructor Create(aOwner: TAddShadowSetDlg; SQLText: string);
    property ErrorMessage: string read FErrorMessage;
  end;

{ TCreateShadowThread }

procedure TCreateShadowThread.Execute;
begin
  FErrorMessage := '';
  try
    with FOwner.ExecSQL do
    begin
      Transaction.Active := true;
      SQL.Text := FSQLText;
      ExecQuery;
      Transaction.Commit;
    end;
  except On E:Exception do
    FErrorMessage := E.Message;
  end;
end;

constructor TCreateShadowThread.Create(aOwner: TAddShadowSetDlg; SQLText: string
  );
begin
  inherited Create(false);
  FOwner := aOwner;
  FErrorMessage := '';
  FSQLText := SQLText;
end;


{ TAddShadowSetDlg }

procedure TAddShadowSetDlg.FormClose(Sender: TObject;
  var CloseAction: TCloseAction);
var SQLText: string;
    Mode: string;
    StartAt: integer;
    FileName: string;
    FileLength: integer;
begin
  if ModalResult = mrYes then
  begin
    ShadowFileList.DisableControls;
    ShadowFileList.Last;
    if not ShadowFileList.FieldByName('ShadowFileLength').IsNull then
    begin
      MessageDlg(sLengthIgnored,mtWarning,[mbOK],0);
      CloseAction := caNone;
      Exit;
    end;

    ShadowFileList.First;
    case ShadowMode.ItemIndex of
    0: Mode := 'AUTO';
    1: Mode := 'MANUAL';
    2: Mode := 'CONDITIONAL';
    end;
    if ShadowFileList.RecordCount = 1 then
      SQLText := Format(sCreateShadow,[FShadowSet,Mode,ShadowFileList.FieldByName('ShadowFileName').AsString])
    else
    begin
      if ShadowFileList.FieldByName('ShadowFileLength').AsInteger = 0 then
      begin
        MessageDlg(sNoLength,mtError,[mbOK],0);
        CloseAction := caNone;
        Exit;
      end;
      SQLText := Format(sCreateFirstShadow,[FShadowSet,Mode,
                                            ShadowFileList.FieldByName('ShadowFileName').AsString,
                                            ShadowFileList.FieldByName('ShadowFileLength').AsInteger]);
      StartAt := ShadowFileList.FieldByName('ShadowFileLength').AsInteger;
      ShadowFileList.Next;
      while not ShadowFileList.EOF do
      begin
        FileName := ShadowFileList.FieldByName('ShadowFileName').AsString;
        FileLength := ShadowFileList.FieldByName('ShadowFileLength').AsInteger;
        ShadowFileList.Next;
        if ShadowFileList.EOF then
          SQLText := SQLText + ' ' + Format(sCreateLastShadow,[FileName,StartAt+1])
        else
        begin
          if FileLength = 0 then
          begin
            MessageDlg(sNoLength,mtError,[mbOK],0);
            CloseAction := caNone;
            Exit;
          end;
          Inc(StartAt,FileLength);
          SQLText := SQLText + ' ' + Format(sNextShadow,[FileName,FileLength]);
        end;
      end;
    end;
    Creating.Visible := true;
    ProgressBar.Visible := true;
    Application.ProcessMessages;
//     writeln(SQLText);
    FShadowThread := TCreateShadowThread.Create(self,SQLText);
    WaitTimer.Enabled := true;
    CloseAction := caNone;
  end;
end;

procedure TAddShadowSetDlg.FormShow(Sender: TObject);
begin
  Creating.Visible := false;
  ProgressBar.Visible := false;
  ShadowFileList.Clear(false);
end;

procedure TAddShadowSetDlg.AddExecute(Sender: TObject);
var aFileName: string;
    aFileLength: integer;
    Pages: boolean;
begin
  if AddShadowFileDlg.ShowModal(aFileName,aFileLength,Pages) = mrOK then
  begin
    if not Pages then
    begin
      if aFileLength <> -1 then
        aFileLength := aFileLength*1024*1024 div IBDatabaseInfo.PageSize;
    end;
    with ShadowFileList do
    begin
      Append;
      FieldByName('ShadowFileName').AsString := aFileName;
      if aFileLength <> -1 then
        FieldByName('ShadowFileLength').AsInteger := aFileLength;
      Post;
    end;
  end;
end;

procedure TAddShadowSetDlg.RemoveExecute(Sender: TObject);
begin
  ShadowFileList.Delete;
end;

procedure TAddShadowSetDlg.RemoveUpdate(Sender: TObject);
begin
  (Sender as TAction).Enabled := ShadowFileList.Active and (ShadowFileList.RecordCount > 0);
end;

procedure TAddShadowSetDlg.ShadowFileListBeforeClose(DataSet: TDataSet);
begin
  ShadowFileList.Clear(false);
end;

procedure TAddShadowSetDlg.ShadowSetEditingDone(Sender: TObject);
begin
  FShadowSet := StrToInt(ShadowSet.Text);
end;

procedure TAddShadowSetDlg.WaitTimerTimer(Sender: TObject);
begin
  with TCreateShadowThread(FShadowThread) do
  begin
    if Finished then
    begin
      if ErrorMessage <> '' then
      begin
        MessageDlg(ErrorMessage,mtError,[mbOK],0);
        ModalResult := mrCancel;
      end;
      ShadowFileList.EnableControls;
      WaitTimer.Enabled := false;
      ModalResult := mrOK;
      Free;
    end;
  end;
end;

function TAddShadowSetDlg.ShowModal(aShadowSet: integer): TModalResult;
begin
  FShadowSet := aShadowSet;
  ShadowSet.Text := IntToStr(aShadowSet);
  Result := inherited ShowModal;
end;


end.

Revision:	380
Committed:	Mon Jan 10 10:13:17 2022 UTC (2 years, 3 months ago) by tony
Content type:	text/x-pascal
File size:	7672 byte(s)
Log Message:	propset for eol-style
#	Content
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 := aFileLength10241024 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