Author: Kim Sandell
In the Interbase Admin components there is a IBBackupService but is hard to use as
it is. This component makes this alot easier, and also works in a thread.
Answer:
1
2 (*
3 Interbase Backup Thread
4
5 Author
6 Kim Sandell
7 Email: kim.sandell@nsftele.com
8
9 Description
10 A Thread that performs an backup of an interbase database on the fly.
11
12 Version
13 1.0
14
15 History
16 23.09.2002 - Initial version
17
18 Known issues
19 None so far ...
20
21 Example of usage
22
23 The example below assumes you have included the "IBBackupThread" unit
24 in the uses clause, and that you have a button on a form.
25
26 The example makes 10 fragments, each max 4 Megabytes. If the backup
27 is larger, the last (10th fragment) will be bigger than 4 Megs.
28
29 procedure TForm1.Button1Click(Sender: TObject);
30 Var
31 IBB: TIBBackupThread;
32 begin
33 IBB := NIL;
34 Try
35 IBB := TIBBackupThread.Create(True);
36 IBB.Initialize;
37 IBB.BackupPath := 'C:\Databases';
38 IBB.DatabaseName := '127.0.0.1:C:\Databases\MyIBDB.GDB';
39 IBB.DatabaseUsername := 'SYSDBA';
40 IBB.DatabasePassword := 'masterkey';
41 IBB.Fragments := 4;
42 IBB.FragmentSizeK := 4096;
43 IBB.Resume;
44 While Not IBB.Terminated do
45 Begin
46 SleepEx(1,True);
47 Application.ProcessMessages;
48 End;
49 IBB.WaitForAndSleep;
50 If IBB.Success then
51 Begin
52 MessageDlg('Backup OK',mtInformation,[mbOK],0);
53 ShowMessage( IBB.BackupLog.Text );
54 End Else MessageDlg('Backup FAILED',mtError,[mbOK],0);
55 Finally
56 IBB.Free;
57 End;
58 end;
59 *)
60 unit IBBackupThread;
61
62 interface
63
64 uses
65 Windows, Messages, SysUtils, Classes,
66 IB, IBServices;
67
68 type
69 TIBBackupThread = class(TThread)
70 private
71 { Private declarations }
72 protected
73 { Protected declarations }
74 function BackupDatabase: Boolean;
75 public
76 { Public declarations }
77 BackupOptions: TBackupOptions; // Backup Options
78 BackupLog: TStringList; // A Stringlist with the results of the backup
79 BackupPath: string; // Path on server
80 DatabaseName: string; // Fully qualifyed name to db
81 DatabaseUsername: string; // Username
82 DatabasePassword: string; // Password
83 Fragments: Cardinal; // How many backup files. 0 means 1 file.
84 FragmentSizeK: Cardinal; // Max Size of a backup fragment in KByte
85 Success: Boolean; // After operation, indicates Success or Fail
86
87 property Terminated; // Make the Terminated published
88
89 { Methods }
90 procedure Initialize;
91 destructor Destroy; override;
92 procedure Execute; override;
93 procedure WaitForAndSleep; // Special WaitFor that does not take 100% CPU
94 published
95 { Published declarations }
96 end;
97
98 implementation
99
100 { TIBBackupThread }
101
102 procedure TIBBackupThread.Initialize;
103 begin
104 { Create variables }
105 BackupLog := TStringList.Create;
106 { Initialize default values }
107 BackupPath := '';
108 DatabaseName := '';
109 DatabaseUsername := 'SYSDBA';
110 DatabasePassword := '';
111 Fragments := 0;
112 FragmentSizeK := 0;
113 Success := False;
114 { Default to no options }
115 BackupOptions := [];
116 end;
117
118 destructor TIBBackupThread.Destroy;
119 begin
120 try
121 { Free the result list }
122 if Assigned(BackupLog) then
123 BackupLog.Free;
124 finally
125 inherited;
126 end;
127 end;
128
129 procedure TIBBackupThread.WaitForAndSleep;
130 var
131 H: THandle;
132 D: DWord;
133 begin
134 { Get Handle }
135 H := Handle;
136 { Wait for it to terminate }
137 repeat
138 D := WaitForSingleObject(H, 1);
139 { System Slizes }
140 SleepEx(1, True);
141 until (Terminated) or ((D <> WAIT_TIMEOUT) and (D <> WAIT_OBJECT_0));
142 end;
143
144 procedure TIBBackupThread.Execute;
145 begin
146 try
147 { Do not free it on termination }
148 FreeOnTerminate := False;
149 { Set lower priority }
150 Priority := tpLower; // tpXXXXX variables
151 try
152 Success := BackupDatabase;
153 finally
154 end;
155 except
156 end;
157 { Signal the termination of the Thread }
158 Terminate;
159 end;
160
161 function TIBBackupThread.BackupDatabase: Boolean;
162 var
163 IBBack: TIBBackupService;
164 SrvAddr: string;
165 DBPath: string;
166 BakPath: string;
167 BakName: string;
168 I: Integer;
169
170 { Leading Zero function }
171 function Lz(Value: Cardinal; Digits: Byte): string;
172 begin
173 Result := IntToStr(Value);
174 while Length(Result)
175 end;
176
177 begin
178 { Default Result }
179 Result := False;
180 try
181 { Clear log }
182 BackupLog.Clear;
183 { Initialize Values }
184 IBBack := nil;
185 { Extract SrvAddr and DBPath from DatabaseName }
186 BakPath := IncludeTrailingPathDelimiter(BackupPath);
187 SrvAddr := DatabaseName;
188 { Correct if Local machine }
189 if Pos(':', SrvAddr) <> 0 then
190 begin
191 Delete(SrvAddr, Pos(':', SrvAddr), Length(SrvAddr));
192 DBPath := DatabaseName;
193 Delete(DBPath, 1, Pos(':', DBPath));
194 end
195 else
196 begin
197 { Must be localhost since Server Address is missing }
198 SrvAddr := '127.0.0.1';
199 DBPath := DatabaseName;
200 end;
201 { Make sure the Fragments & Size are is OK }
202 if FragmentSizeK = 0 then
203 Fragments := 0;
204 if Fragments > 999 then
205 Fragments := 999;
206 if Fragments = 0 then
207 FragmentSizeK := 0;
208 try
209 { Create the Backup service component }
210 IBBack := TIBBackupService.Create(nil);
211 IBBack.Protocol := TCP;
212 IBBack.LoginPrompt := False;
213 IBBack.Params.Values['user_name'] := DatabaseUsername;
214 IBBack.Params.Values['password'] := DatabasePassword;
215 IBBack.ServerName := SrvAddr;
216 IBBack.DatabaseName := DBPath;
217 IBBack.Options := BackupOptions;
218 IBBack.Active := True;
219 try
220 IBBack.Verbose := True;
221 { Add the Backup filenames }
222 for I := 0 to Fragments do
223 begin
224 { Create the Backup filename }
225 BakName := ExtractFileName(DBPath);
226 Delete(BakName, Pos('.', BakName), Length(BakName));
227 BakName := IncludeTrailingPathDelimiter(BackupPath) + BakName;
228 { Check if we need to make a fragment file }
229 if I = 0 then
230 begin
231 BakName := BakName + '_' + FormatDateTime('YYYYMMDD_HHNNSS', Now) +
232 '.gbk';
233 if (FragmentSizeK > 0) then
234 BakName := BakName + ' = ' + IntToStr(FragmentSizeK * 1024);
235 end
236 else
237 begin
238 BakName := BakName + '_' + FormatDateTime('YYYYMMDD_HHNNSS', Now) +
239 '.gbk_'
240 + Lz(I, 3);
241 if (FragmentSizeK > 0) then
242 BakName := BakName + ' = ' + IntToStr(FragmentSizeK * 1024);
243 end;
244 { Add the Bakup name to the Filelist }
245 IBBack.BackupFile.Add(BakName);
246 end;
247 { Start the Service }
248 IBBack.ServiceStart;
249 { Get the Resulting Report Lines }
250 while not IBBack.Eof do
251 begin
252 BackupLog.Append(IBBack.GetNextLine);
253 Sleep(1);
254 end;
255 finally
256 { Turn the Backup service off }
257 IBBack.Active := False;
258 end;
259 { Return results }
260 Result := True;
261 finally
262 if Assigned(IBBack) then
263 begin
264 IBBack.Active := False;
265 IBBack.Free;
266 end;
267 end;
268 except
269 on E: Exception do
270 ; // Log error here
271 end;
272 end;
273
274 end.
|