ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/examples/services/RestoreDlgUnit.pas
Revision: 209
Committed: Wed Mar 14 12:48:51 2018 UTC (6 years ago) by tony
Content type: text/x-pascal
File size: 4126 byte(s)
Log Message:
Fixes Merged

File Contents

# Content
1 (*
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, IBXServices;
36
37 type
38
39 { TRestoreDlg }
40
41 TRestoreDlg = class(TForm)
42 Bevel1: TBevel;
43 Button1: TButton;
44 Button2: TButton;
45 CSRestoreService1: TIBXClientSideRestoreService;
46 SSRestoreService1: TIBXServerSideRestoreService;
47 ReplaceExisting: TCheckBox;
48 ServerName: TEdit;
49 DBName: TEdit;
50 BackupFileName: TEdit;
51 Label1: TLabel;
52 Label2: TLabel;
53 Label3: TLabel;
54 OpenDialog1: TOpenDialog;
55 ServerSideBtn: TRadioButton;
56 ClientSideBtn: TRadioButton;
57 SpeedButton1: TSpeedButton;
58 procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
59 procedure FormShow(Sender: TObject);
60 procedure IBRestoreService1GetNextLine(Sender: TObject; var Line: string);
61 procedure SpeedButton1Click(Sender: TObject);
62 private
63 { private declarations }
64 FOutputLog: TStrings;
65 procedure RunRestore;
66 public
67 { public declarations }
68 function ShowModal(var aDBName: string; OutputLog: TStrings): TModalResult;
69 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 BackupFileName.Text := OpenDialog1.Filename;
84 end;
85
86 procedure TRestoreDlg.RunRestore;
87 begin
88 FOutputLog.Add('Restore Started');
89 if ClientSideBtn.Checked then
90 CSRestoreService1.RestoreFromFile(BackupFilename.Text,FOutputLog)
91 else
92 SSRestoreService1.Execute(FOutputLog);
93
94 FOutputLog.Add('Restore Completed');
95 MessageDlg('Restore Completed',mtInformation,[mbOK],0);
96 end;
97
98 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 procedure TRestoreDlg.FormShow(Sender: TObject);
112 begin
113 ServerName.Text := CSRestoreService1.ServicesConnection.ServerName;
114 end;
115
116 procedure TRestoreDlg.IBRestoreService1GetNextLine(Sender: TObject;
117 var Line: string);
118 begin
119 Application.ProcessMessages;
120 end;
121
122 procedure TRestoreDlg.FormClose(Sender: TObject; var CloseAction: TCloseAction);
123 begin
124 if ModalResult <> mrOK then Exit;
125 if DBName.Text = '' then
126 raise Exception.Create('A Database Name must be given');
127 if BackupFileName.Text = '' then
128 raise Exception.Create('A Backup File Name must be given');
129 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 else
141 begin
142 CSRestoreService1.Options := CSRestoreService1.Options - [Replace] + [CreateNewDB];
143 SSRestoreService1.Options := SSRestoreService1.Options - [Replace] + [CreateNewDB];
144 end;
145 end;
146
147 end.
148