examples/services/RestoreDlgUnit.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 RestoreDlgUnit;

{$mode objfpc}{$H+}

interface

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

type

  { TRestoreDlg }

  TRestoreDlg = class(TForm)
    Bevel1: TBevel;
    Button1: TButton;
    Button2: TButton;
    CheckBox1: TCheckBox;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    IBRestoreService1: TIBRestoreService;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    OpenDialog1: TOpenDialog;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    SpeedButton1: TSpeedButton;
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
    procedure RunRestore;
  end;

var
  RestoreDlg: TRestoreDlg;

implementation

{$R *.lfm}

uses MainFormUnit;

{ TRestoreDlg }

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

procedure TRestoreDlg.RunRestore;
var bakfile: TFileStream;
    line: string;
begin
  bakfile := nil;
  if IBRestoreService1.BackupFileLocation = flClientSide then
    bakfile := TFileStream.Create(IBRestoreService1.BackupFile[0],fmOpenRead);
  MainForm.Memo1.Lines.Add('Restore Started');
  try
    IBRestoreService1.ServiceStart;
    while not IBRestoreService1.Eof do
    begin
      case IBRestoreService1.BackupFileLocation of
      flServerSide:
        MainForm.Memo1.Lines.Add(Trim(IBRestoreService1.GetNextLine));
      flClientSide:
        begin
          IBRestoreService1.SendNextChunk(bakfile,line);
          if line <> '' then
           MainForm. Memo1.Lines.Add(line);
        end;
      end;
      Application.ProcessMessages
    end;
  finally
    if bakfile <> nil then
      bakfile.Free;
  end;
  while IBRestoreService1.IsServiceRunning do; {flush}

  MainForm.Memo1.Lines.Add('Restore Completed');
  MessageDlg('Restore Completed',mtInformation,[mbOK],0);
end;

procedure TRestoreDlg.FormShow(Sender: TObject);
begin
  Edit1.Text := IBRestoreService1.ServerName;
  if IBRestoreService1.BackupFileLocation = flServerSide then
    RadioButton1.Checked := true
  else
    RadioButton2.Checked := true;
  Edit2.Text := IBRestoreService1.DatabaseName[0];
  IBRestoreService1.BackupFile.Clear;
end;

procedure TRestoreDlg.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');
  IBRestoreService1.DatabaseName.Clear;
  IBRestoreService1.DatabaseName.Add(Edit2.Text);
  IBRestoreService1.BackupFile.Add(Edit3.Text);
  if RadioButton1.Checked then
     IBRestoreService1.BackupFileLocation := flServerSide
  else
    IBRestoreService1.BackupFileLocation := flClientSide;
  if CheckBox1.Checked then
     IBRestoreService1.Options := IBRestoreService1.Options + [Replace] - [CreateNewDB]
  else
    IBRestoreService1.Options := IBRestoreService1.Options - [Replace] + [CreateNewDB]

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 RestoreDlgUnit;
28
29			{$mode objfpc}{$H+}
30
31			interface
32
33			uses
34			Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
35			StdCtrls, Buttons, IBServices;
36
37			type
38
39			{ TRestoreDlg }
40
41			TRestoreDlg = class(TForm)
42			Bevel1: TBevel;
43			Button1: TButton;
44			Button2: TButton;
45			CheckBox1: TCheckBox;
46			Edit1: TEdit;
47			Edit2: TEdit;
48			Edit3: TEdit;
49			IBRestoreService1: TIBRestoreService;
50			Label1: TLabel;
51			Label2: TLabel;
52			Label3: TLabel;
53			OpenDialog1: TOpenDialog;
54			RadioButton1: TRadioButton;
55			RadioButton2: TRadioButton;
56			SpeedButton1: TSpeedButton;
57			procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
58			procedure FormShow(Sender: TObject);
59			procedure SpeedButton1Click(Sender: TObject);
60			private
61			{ private declarations }
62			public
63			{ public declarations }
64			procedure RunRestore;
65			end;
66
67			var
68			RestoreDlg: TRestoreDlg;
69
70			implementation
71
72			{$R *.lfm}
73
74			uses MainFormUnit;
75
76			{ TRestoreDlg }
77
78			procedure TRestoreDlg.SpeedButton1Click(Sender: TObject);
79			begin
80			if OpenDialog1.Execute then
81			Edit3.Text := OpenDialog1.Filename;
82			end;
83
84			procedure TRestoreDlg.RunRestore;
85			var bakfile: TFileStream;
86			line: string;
87			begin
88			bakfile := nil;
89			if IBRestoreService1.BackupFileLocation = flClientSide then
90			bakfile := TFileStream.Create(IBRestoreService1.BackupFile[0],fmOpenRead);
91			MainForm.Memo1.Lines.Add('Restore Started');
92			try
93			IBRestoreService1.ServiceStart;
94			while not IBRestoreService1.Eof do
95			begin
96			case IBRestoreService1.BackupFileLocation of
97			flServerSide:
98			MainForm.Memo1.Lines.Add(Trim(IBRestoreService1.GetNextLine));
99			flClientSide:
100			begin
101			IBRestoreService1.SendNextChunk(bakfile,line);
102			if line <> '' then
103			MainForm. Memo1.Lines.Add(line);
104			end;
105			end;
106			Application.ProcessMessages
107			end;
108			finally
109			if bakfile <> nil then
110			bakfile.Free;
111			end;
112			while IBRestoreService1.IsServiceRunning do; {flush}
113
114			MainForm.Memo1.Lines.Add('Restore Completed');
115			MessageDlg('Restore Completed',mtInformation,[mbOK],0);
116			end;
117
118			procedure TRestoreDlg.FormShow(Sender: TObject);
119			begin
120			Edit1.Text := IBRestoreService1.ServerName;
121			if IBRestoreService1.BackupFileLocation = flServerSide then
122			RadioButton1.Checked := true
123			else
124			RadioButton2.Checked := true;
125			Edit2.Text := IBRestoreService1.DatabaseName[0];
126			IBRestoreService1.BackupFile.Clear;
127			end;
128
129			procedure TRestoreDlg.FormClose(Sender: TObject; var CloseAction: TCloseAction);
130			begin
131			if ModalResult <> mrOK then Exit;
132			if Edit2.Text = '' then
133			raise Exception.Create('A Database Name must be given');
134			if Edit3.Text = '' then
135			raise Exception.Create('A Backup File Name must be given');
136			IBRestoreService1.DatabaseName.Clear;
137			IBRestoreService1.DatabaseName.Add(Edit2.Text);
138			IBRestoreService1.BackupFile.Add(Edit3.Text);
139			if RadioButton1.Checked then
140			IBRestoreService1.BackupFileLocation := flServerSide
141			else
142			IBRestoreService1.BackupFileLocation := flClientSide;
143			if CheckBox1.Checked then
144			IBRestoreService1.Options := IBRestoreService1.Options + [Replace] - [CreateNewDB]
145			else
146			IBRestoreService1.Options := IBRestoreService1.Options - [Replace] + [CreateNewDB]
147
148			end;
149
150			end.
151