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

type

  { TRestoreDlg }

  TRestoreDlg = class(TForm)
    Bevel1: TBevel;
    Button1: TButton;
    Button2: TButton;
    CSRestoreService1: TIBXClientSideRestoreService;
    SSRestoreService1: TIBXServerSideRestoreService;
    ReplaceExisting: TCheckBox;
    ServerName: TEdit;
    DBName: TEdit;
    BackupFileName: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    OpenDialog1: TOpenDialog;
    ServerSideBtn: TRadioButton;
    ClientSideBtn: TRadioButton;
    SpeedButton1: TSpeedButton;
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure IBRestoreService1GetNextLine(Sender: TObject; var Line: string);
    procedure SpeedButton1Click(Sender: TObject);
  private
    { private declarations }
    FOutputLog: TStrings;
    procedure RunRestore;
  public
    { public declarations }
    function ShowModal(var aDBName: string; OutputLog: TStrings): TModalResult;
  end;

var
  RestoreDlg: TRestoreDlg;

implementation

{$R *.lfm}

{ TRestoreDlg }

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

procedure TRestoreDlg.RunRestore;
begin
  FOutputLog.Add('Restore Started');
  if ClientSideBtn.Checked then
    CSRestoreService1.RestoreFromFile(BackupFilename.Text,FOutputLog)
  else
    SSRestoreService1.Execute(FOutputLog);

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

function TRestoreDlg.ShowModal(var aDBName: string; OutputLog: TStrings
  ): TModalResult;
begin
  DBName.Text := aDBName;
  FOutputLog := OutputLog;
  Result := inherited ShowModal;
  if Result = mrOK then
  begin
    RunRestore;
    aDBName := DBName.Text;
  end;
end;

procedure TRestoreDlg.FormShow(Sender: TObject);
begin
  ServerName.Text := CSRestoreService1.ServicesConnection.ServerName;
end;

procedure TRestoreDlg.IBRestoreService1GetNextLine(Sender: TObject;
  var Line: string);
begin
  Application.ProcessMessages;
end;

procedure TRestoreDlg.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
  if ModalResult <> mrOK then Exit;
  if DBName.Text = '' then
    raise Exception.Create('A Database Name must be given');
  if BackupFileName.Text = '' then
    raise Exception.Create('A Backup File Name must be given');
  CSRestoreService1.DatabaseFiles.Clear;
  CSRestoreService1.DatabaseFiles.Add(DBName.Text);
  SSRestoreService1.DatabaseFiles.Clear;
  SSRestoreService1.DatabaseFiles.Add(DBName.Text);
  SSRestoreService1.BackupFiles.Clear;
  SSRestoreService1.BackupFiles.Add(BackupFileName.Text);
  if ReplaceExisting.Checked then
  begin
     CSRestoreService1.Options := CSRestoreService1.Options + [Replace] - [CreateNewDB];
     SSRestoreService1.Options := SSRestoreService1.Options + [Replace] - [CreateNewDB];
  end
  else
  begin
    CSRestoreService1.Options := CSRestoreService1.Options - [Replace] + [CreateNewDB];
    SSRestoreService1.Options := SSRestoreService1.Options - [Replace] + [CreateNewDB];
  end;
end;

end.

Revision:	209
Committed:	Wed Mar 14 12:48:51 2018 UTC (6 years, 1 month ago) by tony
Content type:	text/x-pascal
File size:	4126 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	tony	209	StdCtrls, Buttons, IBXServices;
36	tony	143
37			type
38
39			{ TRestoreDlg }
40
41			TRestoreDlg = class(TForm)
42			Bevel1: TBevel;
43			Button1: TButton;
44			Button2: TButton;
45	tony	209	CSRestoreService1: TIBXClientSideRestoreService;
46			SSRestoreService1: TIBXServerSideRestoreService;
47			ReplaceExisting: TCheckBox;
48			ServerName: TEdit;
49			DBName: TEdit;
50			BackupFileName: TEdit;
51	tony	143	Label1: TLabel;
52			Label2: TLabel;
53			Label3: TLabel;
54			OpenDialog1: TOpenDialog;
55	tony	209	ServerSideBtn: TRadioButton;
56			ClientSideBtn: TRadioButton;
57	tony	143	SpeedButton1: TSpeedButton;
58			procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
59			procedure FormShow(Sender: TObject);
60	tony	209	procedure IBRestoreService1GetNextLine(Sender: TObject; var Line: string);
61	tony	143	procedure SpeedButton1Click(Sender: TObject);
62			private
63			{ private declarations }
64	tony	209	FOutputLog: TStrings;
65			procedure RunRestore;
66	tony	143	public
67			{ public declarations }
68	tony	209	function ShowModal(var aDBName: string; OutputLog: TStrings): TModalResult;
69	tony	143	end;
70
71			var
72			RestoreDlg: TRestoreDlg;
73
74			implementation
75
76			{$R *.lfm}
77
78			{ TRestoreDlg }
79
80			procedure TRestoreDlg.SpeedButton1Click(Sender: TObject);
81			begin
82			if OpenDialog1.Execute then
83	tony	209	BackupFileName.Text := OpenDialog1.Filename;
84	tony	143	end;
85
86			procedure TRestoreDlg.RunRestore;
87			begin
88	tony	209	FOutputLog.Add('Restore Started');
89			if ClientSideBtn.Checked then
90			CSRestoreService1.RestoreFromFile(BackupFilename.Text,FOutputLog)
91			else
92			SSRestoreService1.Execute(FOutputLog);
93	tony	143
94	tony	209	FOutputLog.Add('Restore Completed');
95	tony	143	MessageDlg('Restore Completed',mtInformation,[mbOK],0);
96			end;
97
98	tony	209	function TRestoreDlg.ShowModal(var aDBName: string; OutputLog: TStrings
99			): TModalResult;
100			begin
101			DBName.Text := aDBName;
102			FOutputLog := OutputLog;
103			Result := inherited ShowModal;
104			if Result = mrOK then
105			begin
106			RunRestore;
107			aDBName := DBName.Text;
108			end;
109			end;
110
111	tony	143	procedure TRestoreDlg.FormShow(Sender: TObject);
112			begin
113	tony	209	ServerName.Text := CSRestoreService1.ServicesConnection.ServerName;
114	tony	143	end;
115
116	tony	209	procedure TRestoreDlg.IBRestoreService1GetNextLine(Sender: TObject;
117			var Line: string);
118			begin
119			Application.ProcessMessages;
120			end;
121
122	tony	143	procedure TRestoreDlg.FormClose(Sender: TObject; var CloseAction: TCloseAction);
123			begin
124			if ModalResult <> mrOK then Exit;
125	tony	209	if DBName.Text = '' then
126	tony	143	raise Exception.Create('A Database Name must be given');
127	tony	209	if BackupFileName.Text = '' then
128	tony	143	raise Exception.Create('A Backup File Name must be given');
129	tony	209	CSRestoreService1.DatabaseFiles.Clear;
130			CSRestoreService1.DatabaseFiles.Add(DBName.Text);
131			SSRestoreService1.DatabaseFiles.Clear;
132			SSRestoreService1.DatabaseFiles.Add(DBName.Text);
133			SSRestoreService1.BackupFiles.Clear;
134			SSRestoreService1.BackupFiles.Add(BackupFileName.Text);
135			if ReplaceExisting.Checked then
136			begin
137			CSRestoreService1.Options := CSRestoreService1.Options + [Replace] - [CreateNewDB];
138			SSRestoreService1.Options := SSRestoreService1.Options + [Replace] - [CreateNewDB];
139			end
140	tony	143	else
141	tony	209	begin
142			CSRestoreService1.Options := CSRestoreService1.Options - [Replace] + [CreateNewDB];
143			SSRestoreService1.Options := SSRestoreService1.Options - [Replace] + [CreateNewDB];
144			end;
145	tony	143	end;
146
147			end.
148