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, IBServices;

type

  { TBackupDlg }

  TBackupDlg = class(TForm)
    Button1: TButton;
    Button2: TButton;
    NoDBTriggers: TCheckBox;
    NoGarbageCollection: TCheckBox;
    MetadataOnly: TCheckBox;
    IgnoreLimboTransactions: TCheckBox;
    IgnoreChecksums: TCheckBox;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    IBBackupService1: TIBBackupService;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Report: TMemo;
    PageControl1: TPageControl;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    SaveDialog1: TSaveDialog;
    SpeedButton1: TSpeedButton;
    SelectTab: TTabSheet;
    ReportTab: TTabSheet;
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure ReportTabShow(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
  private
    { private declarations }
    procedure DoBackup(Data: PtrInt);
  public
    { public declarations }
 end;

var
  BackupDlg: TBackupDlg;

implementation

{$R *.lfm}

{ TBackupDlg }

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

procedure TBackupDlg.DoBackup(Data: PtrInt);
var bakfile: TFileStream;
    BackupCount: integer;
begin
  bakfile := nil;
  with IBBackupService1 do
  begin
  Options := [];
  if IgnoreChecksums.Checked then
    Options := Options + [IBServices.IgnoreChecksums];
  if IgnoreLimboTransactions.Checked then
    Options := Options + [IgnoreLimbo];
  if MetadataOnly.Checked then
    Options := Options + [IBServices.MetadataOnly];
  if NoGarbageCollection.Checked then
    Options := Options + [IBServices.NoGarbageCollection];
  if NoDBTriggers.Checked then
    Options := Options + [IBServices.NoDBTriggers];
  end;

  Report.Lines.Add('Starting Backup');
  if IBBackupService1.BackupFileLocation = flClientSide then
    bakfile := TFileStream.Create(IBBackupService1.BackupFile[0],fmCreate);
  try
    IBBackupService1.ServiceStart;
    while not IBBackupService1.Eof do
    begin
      case IBBackupService1.BackupFileLocation of
      flServerSide:
        Report.Lines.Add(IBBackupService1.GetNextLine);
      flClientSide:
        IBBackupService1.WriteNextChunk(bakfile);
      end;
      Application.ProcessMessages;
    end;
    if bakfile <> nil then
      BackupCount := bakfile.Size;
  finally
    if bakfile <> nil then
      bakfile.Free;
  end;

  while IBBackupService1.IsServiceRunning do; {flush}

  {Report completion}
  case IBBackupService1.BackupFileLocation of
  flServerSide:
    begin
      Report.Lines.Add('Backup Completed');
      MessageDlg('Backup Completed',mtInformation,[mbOK],0);
    end;
  flClientSide:
    begin
      Report.Lines.Add(Format('Backup Completed - File Size = %d bytes',[BackupCount]));
      MessageDlg(Format('Backup Completed - File Size = %d bytes',[BackupCount]),mtInformation,[mbOK],0);
    end;
  end;
  IBBackupService1.Active := false;
end;

procedure TBackupDlg.FormShow(Sender: TObject);
begin
  PageControl1.ActivePage := SelectTab;
  Edit1.Text := IBBackupService1.ServerName;
  if IBBackupService1.BackupFileLocation = flServerSide then
    RadioButton1.Checked := true
  else
    RadioButton2.Checked := true;
  Edit2.Text := IBBackupService1.DatabaseName;
  IBBackupService1.BackupFile.Clear;
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 Edit3.Text = '' then
      raise Exception.Create('A Backup File Name must be given');
    IBBackupService1.BackupFile.Add(Edit3.Text);
    if RadioButton1.Checked then
       IBBackupService1.BackupFileLocation := flServerSide
    else
      IBBackupService1.BackupFileLocation := flClientSide;
    PageControl1.ActivePage := ReportTab;
    Application.QueueAsyncCall(@DoBackup,0);
  end;
end;

end.

Revision:	158
Committed:	Thu Mar 1 11:23:33 2018 UTC (6 years, 1 month ago) by tony
Content type:	text/x-pascal
File size:	4959 byte(s)
Log Message:	Repository resync
#	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			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