examples/services/BackupDlgUnit.pas

(*
 *  IBX For Lazarus (Firebird Express)
 *
 *  The contents of this file are subject to the Initial Developer's
 *  Public License Version 1.0 (the "License"); you may not use this
 *  file except in compliance with the License. You may obtain a copy
 *  of the License here:
 *
 *    http://www.firebirdsql.org/index.php?op=doc&id=idpl
 *
 *  Software distributed under the License is distributed on an "AS
 *  IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
 *  implied. See the License for the specific language governing rights
 *  and limitations under the License.
 *
 *  The Initial Developer of the Original Code is Tony Whyman.
 *
 *  The Original Code is (C) 2015 Tony Whyman, MWA Software
 *  (http://www.mwasoftware.co.uk).
 *
 *  All Rights Reserved.
 *
 *  Contributor(s): ______________________________________.
 *
*) 
            
unit BackupDlgUnit;

{$mode objfpc}{$H+}

interface

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

type

  { TBackupDlg }

  TBackupDlg = class(TForm)
    Bevel1: TBevel;
    Button1: TButton;
    Button2: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    IBBackupService1: TIBBackupService;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    SaveDialog1: TSaveDialog;
    SpeedButton1: TSpeedButton;
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
     procedure RunBackup;
 end;

var
  BackupDlg: TBackupDlg;

implementation

{$R *.lfm}

uses MainFormUnit;

{ TBackupDlg }

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

procedure TBackupDlg.RunBackup;
var bakfile: TFileStream;
    BackupCount: integer;
begin
  bakfile := nil;
  MainForm.Memo1.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:
        MainForm.Memo1.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
      MainForm.Memo1.Lines.Add('Backup Completed');
      MessageDlg('Backup Completed',mtInformation,[mbOK],0);
    end;
  flClientSide:
    begin
      MainForm.Memo1.Lines.Add(Format('Backup Completed - File Size = %d bytes',[BackupCount]));
      MessageDlg(Format('Backup Completed - File Size = %d bytes',[BackupCount]),mtInformation,[mbOK],0);
    end;
  end;
end;

procedure TBackupDlg.FormShow(Sender: TObject);
begin
  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.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
  if ModalResult <> mrOK then Exit;
  if Edit2.Text = '' then
    raise Exception.Create('A Database Name must be given');
  if Edit3.Text = '' then
    raise Exception.Create('A Backup File Name must be given');
  IBBackupService1.DatabaseName := Edit2.Text;
  IBBackupService1.BackupFile.Add(Edit3.Text);
  if RadioButton1.Checked then
     IBBackupService1.BackupFileLocation := flServerSide
  else
    IBBackupService1.BackupFileLocation := flClientSide;
end;

end.

Revision:	143
Committed:	Fri Feb 23 12:11:21 2018 UTC (6 years, 9 months ago) by tony
Content type:	text/x-pascal
File size:	4101 byte(s)
Log Message:	Fixes Merged
#	User	Rev	Content
1	tony	143	(*
2			* IBX For Lazarus (Firebird Express)
3			*
4			* The contents of this file are subject to the Initial Developer's
5			* Public License Version 1.0 (the "License"); you may not use this
6			* file except in compliance with the License. You may obtain a copy
7			* of the License here:
8			*
9			* http://www.firebirdsql.org/index.php?op=doc&id=idpl
10			*
11			* Software distributed under the License is distributed on an "AS
12			* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
13			* implied. See the License for the specific language governing rights
14			* and limitations under the License.
15			*
16			* The Initial Developer of the Original Code is Tony Whyman.
17			*
18			* The Original Code is (C) 2015 Tony Whyman, MWA Software
19			* (http://www.mwasoftware.co.uk).
20			*
21			* All Rights Reserved.
22			*
23			* Contributor(s): ______________________________________.
24			*
25			*)
26
27			unit BackupDlgUnit;
28
29			{$mode objfpc}{$H+}
30
31			interface
32
33			uses
34			Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
35			Buttons, ExtCtrls, IBServices;
36
37			type
38
39			{ TBackupDlg }
40
41			TBackupDlg = class(TForm)
42			Bevel1: TBevel;
43			Button1: TButton;
44			Button2: TButton;
45			Edit1: TEdit;
46			Edit2: TEdit;
47			Edit3: TEdit;
48			IBBackupService1: TIBBackupService;
49			Label1: TLabel;
50			Label2: TLabel;
51			Label3: TLabel;
52			RadioButton1: TRadioButton;
53			RadioButton2: TRadioButton;
54			SaveDialog1: TSaveDialog;
55			SpeedButton1: TSpeedButton;
56			procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
57			procedure FormShow(Sender: TObject);
58			procedure SpeedButton1Click(Sender: TObject);
59			private
60			{ private declarations }
61			public
62			{ public declarations }
63			procedure RunBackup;
64			end;
65
66			var
67			BackupDlg: TBackupDlg;
68
69			implementation
70
71			{$R *.lfm}
72
73			uses MainFormUnit;
74
75			{ TBackupDlg }
76
77			procedure TBackupDlg.SpeedButton1Click(Sender: TObject);
78			begin
79			if SaveDialog1.Execute then
80			Edit3.Text := SaveDialog1.Filename;
81			end;
82
83			procedure TBackupDlg.RunBackup;
84			var bakfile: TFileStream;
85			BackupCount: integer;
86			begin
87			bakfile := nil;
88			MainForm.Memo1.Lines.Add('Starting Backup');
89			if IBBackupService1.BackupFileLocation = flClientSide then
90			bakfile := TFileStream.Create(IBBackupService1.BackupFile[0],fmCreate);
91			try
92			IBBackupService1.ServiceStart;
93			while not IBBackupService1.Eof do
94			begin
95			case IBBackupService1.BackupFileLocation of
96			flServerSide:
97			MainForm.Memo1.Lines.Add(IBBackupService1.GetNextLine);
98			flClientSide:
99			IBBackupService1.WriteNextChunk(bakfile);
100			end;
101			Application.ProcessMessages;
102			end;
103			if bakfile <> nil then
104			BackupCount := bakfile.Size;
105			finally
106			if bakfile <> nil then
107			bakfile.Free;
108			end;
109
110			while IBBackupService1.IsServiceRunning do; {flush}
111
112			{Report completion}
113			case IBBackupService1.BackupFileLocation of
114			flServerSide:
115			begin
116			MainForm.Memo1.Lines.Add('Backup Completed');
117			MessageDlg('Backup Completed',mtInformation,[mbOK],0);
118			end;
119			flClientSide:
120			begin
121			MainForm.Memo1.Lines.Add(Format('Backup Completed - File Size = %d bytes',[BackupCount]));
122			MessageDlg(Format('Backup Completed - File Size = %d bytes',[BackupCount]),mtInformation,[mbOK],0);
123			end;
124			end;
125			end;
126
127			procedure TBackupDlg.FormShow(Sender: TObject);
128			begin
129			Edit1.Text := IBBackupService1.ServerName;
130			if IBBackupService1.BackupFileLocation = flServerSide then
131			RadioButton1.Checked := true
132			else
133			RadioButton2.Checked := true;
134			Edit2.Text := IBBackupService1.DatabaseName;
135			IBBackupService1.BackupFile.Clear;
136			end;
137
138			procedure TBackupDlg.FormClose(Sender: TObject; var CloseAction: TCloseAction);
139			begin
140			if ModalResult <> mrOK then Exit;
141			if Edit2.Text = '' then
142			raise Exception.Create('A Database Name must be given');
143			if Edit3.Text = '' then
144			raise Exception.Create('A Backup File Name must be given');
145			IBBackupService1.DatabaseName := Edit2.Text;
146			IBBackupService1.BackupFile.Add(Edit3.Text);
147			if RadioButton1.Checked then
148			IBBackupService1.BackupFileLocation := flServerSide
149			else
150			IBBackupService1.BackupFileLocation := flClientSide;
151			end;
152
153			end.
154