DBAdmin/dlg/BackupDlgUnit.pas

(*
 * BackupDlgUnit.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 BackupDlgUnit;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  Buttons, ExtCtrls, ComCtrls, IBXServices;

type

  { TBackupDlg }

  TBackupDlg = class(TForm)
    Button1: TButton;
    Button2: TButton;
    IBXClientSideBackupService1: TIBXClientSideBackupService;
    IBXServerSideBackupService1: TIBXServerSideBackupService;
    NoDBTriggers: TCheckBox;
    NoGarbageCollection: TCheckBox;
    MetadataOnly: TCheckBox;
    IgnoreLimboTransactions: TCheckBox;
    IgnoreChecksums: TCheckBox;
    ProgressBar1: TProgressBar;
    ServerName: TEdit;
    DBName: TEdit;
    BackupFileName: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Report: TMemo;
    PageControl1: TPageControl;
    ServerSideBtn: TRadioButton;
    ClientSideBtn: TRadioButton;
    SaveDialog1: TSaveDialog;
    SpeedButton1: TSpeedButton;
    SelectTab: TTabSheet;
    ReportTab: TTabSheet;
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure IBXClientSideBackupService1GetNextLine(Sender: TObject;
      var Line: string);
    procedure ReportTabShow(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
  private
    { private declarations }
    procedure DoClientBackup(Data: PtrInt);
    procedure DoServerBackup(Data: PtrInt);
  public
    { public declarations }
 end;

var
  BackupDlg: TBackupDlg;

implementation

{$R *.lfm}

{ TBackupDlg }

procedure TBackupDlg.SpeedButton1Click(Sender: TObject);
begin
  if SaveDialog1.Execute then
    BackupFileName.Text := SaveDialog1.Filename;
end;

procedure TBackupDlg.DoClientBackup(Data: PtrInt);
var BackupCount: integer;
begin
  ProgressBar1.Visible := true;
  with IBXClientSideBackupService1 do
  begin
    Options := [];
    if IgnoreChecksums.Checked then
      Options := Options + [IBXServices.IgnoreChecksums];
    if IgnoreLimboTransactions.Checked then
      Options := Options + [IgnoreLimbo];
    if MetadataOnly.Checked then
      Options := Options + [IBXServices.MetadataOnly];
    if NoGarbageCollection.Checked then
      Options := Options + [IBXServices.NoGarbageCollection];
    if NoDBTriggers.Checked then
      Options := Options + [IBXServices.NoDBTriggers];

    Report.Lines.Add('Starting Backup');
    BackupToFile(BackupFileName.Text, BackupCount);
  end;
  Report.Lines.Add(Format('Backup Completed - File Size = %d bytes',[BackupCount]));
  ProgressBar1.Visible := false;
  MessageDlg(Format('Backup Completed - File Size = %d bytes',[BackupCount]),mtInformation,[mbOK],0);
end;

procedure TBackupDlg.DoServerBackup(Data: PtrInt);
begin
  ProgressBar1.Visible := true;
  with IBXServerSideBackupService1 do
  begin
    BackupFiles.Clear;
    BackupFiles.Add(BackupFileName.Text);
    Options := [];
    if IgnoreChecksums.Checked then
      Options := Options + [IBXServices.IgnoreChecksums];
    if IgnoreLimboTransactions.Checked then
      Options := Options + [IgnoreLimbo];
    if MetadataOnly.Checked then
      Options := Options + [IBXServices.MetadataOnly];
    if NoGarbageCollection.Checked then
      Options := Options + [IBXServices.NoGarbageCollection];
    if NoDBTriggers.Checked then
      Options := Options + [IBXServices.NoDBTriggers];
    Report.Lines.Add('Starting Backup');
    Execute(Report.Lines);
    Report.Lines.Add('Backup Completed');
    ProgressBar1.Visible := false;
    MessageDlg('Backup Completed',mtInformation,[mbOK],0);
  end;
end;

procedure TBackupDlg.FormShow(Sender: TObject);
begin
  PageControl1.ActivePage := SelectTab;
  ServerName.Text := IBXClientSideBackupService1.ServicesConnection.ServerName;
  DBName.Text := IBXClientSideBackupService1.DatabaseName;
  BackupFileName.Text := '';
end;

procedure TBackupDlg.IBXClientSideBackupService1GetNextLine(Sender: TObject;
  var Line: string);
begin
  Application.ProcessMessages;
end;

procedure TBackupDlg.ReportTabShow(Sender: TObject);
begin
  Report.Lines.Clear;
end;

procedure TBackupDlg.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
  if ModalResult <> mrOK then Exit;

  if PageControl1.ActivePage = SelectTab then
  begin
    CloseAction := caNone;
    if BackupFileName.Text = '' then
      raise Exception.Create('A Backup File Name must be given');
    PageControl1.ActivePage := ReportTab;
    Application.ProcessMessages;
    if ServerSideBtn.Checked then
      Application.QueueAsyncCall(@DoServerBackup,0)
    else
      Application.QueueAsyncCall(@DoClientBackup,0);
  end;
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:	5287 byte(s)
Log Message:	propset for eol-style
#	User	Rev	Content
1	tony	158	(*
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	tony	209	Buttons, ExtCtrls, ComCtrls, IBXServices;
27	tony	158
28			type
29
30			{ TBackupDlg }
31
32			TBackupDlg = class(TForm)
33			Button1: TButton;
34			Button2: TButton;
35	tony	209	IBXClientSideBackupService1: TIBXClientSideBackupService;
36			IBXServerSideBackupService1: TIBXServerSideBackupService;
37	tony	158	NoDBTriggers: TCheckBox;
38			NoGarbageCollection: TCheckBox;
39			MetadataOnly: TCheckBox;
40			IgnoreLimboTransactions: TCheckBox;
41			IgnoreChecksums: TCheckBox;
42	tony	272	ProgressBar1: TProgressBar;
43	tony	209	ServerName: TEdit;
44			DBName: TEdit;
45			BackupFileName: TEdit;
46	tony	158	Label1: TLabel;
47			Label2: TLabel;
48			Label3: TLabel;
49			Report: TMemo;
50			PageControl1: TPageControl;
51	tony	209	ServerSideBtn: TRadioButton;
52			ClientSideBtn: TRadioButton;
53	tony	158	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	tony	272	procedure IBXClientSideBackupService1GetNextLine(Sender: TObject;
60			var Line: string);
61	tony	158	procedure ReportTabShow(Sender: TObject);
62			procedure SpeedButton1Click(Sender: TObject);
63			private
64			{ private declarations }
65	tony	209	procedure DoClientBackup(Data: PtrInt);
66			procedure DoServerBackup(Data: PtrInt);
67	tony	158	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	tony	209	BackupFileName.Text := SaveDialog1.Filename;
84	tony	158	end;
85
86	tony	209	procedure TBackupDlg.DoClientBackup(Data: PtrInt);
87			var BackupCount: integer;
88	tony	158	begin
89	tony	272	ProgressBar1.Visible := true;
90	tony	209	with IBXClientSideBackupService1 do
91	tony	158	begin
92	tony	209	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	tony	158
104	tony	209	Report.Lines.Add('Starting Backup');
105			BackupToFile(BackupFileName.Text, BackupCount);
106	tony	158	end;
107	tony	209	Report.Lines.Add(Format('Backup Completed - File Size = %d bytes',[BackupCount]));
108	tony	272	ProgressBar1.Visible := false;
109	tony	209	MessageDlg(Format('Backup Completed - File Size = %d bytes',[BackupCount]),mtInformation,[mbOK],0);
110			end;
111	tony	158
112	tony	209	procedure TBackupDlg.DoServerBackup(Data: PtrInt);
113			begin
114	tony	272	ProgressBar1.Visible := true;
115	tony	209	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	tony	272	ProgressBar1.Visible := false;
134	tony	209	MessageDlg('Backup Completed',mtInformation,[mbOK],0);
135	tony	158	end;
136			end;
137
138			procedure TBackupDlg.FormShow(Sender: TObject);
139			begin
140			PageControl1.ActivePage := SelectTab;
141	tony	209	ServerName.Text := IBXClientSideBackupService1.ServicesConnection.ServerName;
142			DBName.Text := IBXClientSideBackupService1.DatabaseName;
143			BackupFileName.Text := '';
144	tony	158	end;
145
146	tony	272	procedure TBackupDlg.IBXClientSideBackupService1GetNextLine(Sender: TObject;
147			var Line: string);
148			begin
149			Application.ProcessMessages;
150			end;
151
152	tony	158	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	tony	209	if BackupFileName.Text = '' then
165	tony	158	raise Exception.Create('A Backup File Name must be given');
166	tony	209	PageControl1.ActivePage := ReportTab;
167	tony	272	Application.ProcessMessages;
168	tony	209	if ServerSideBtn.Checked then
169			Application.QueueAsyncCall(@DoServerBackup,0)
170	tony	158	else
171	tony	209	Application.QueueAsyncCall(@DoClientBackup,0);
172	tony	158	end;
173			end;
174
175			end.
176