Author: Kim Sandell
In the Interbase Admin components there is a IBValidationService but is hard to use
as it is. Sweeping is just one of the functions of the validation service. This
component makes doing sweeps of databases alot easier, and also works in a thread.
Ideal for use in server applications.
Answer:
1
2 (*
3 Interbase Sweep Thread
4
5 Author
6 Kim Sandell
7 Email: kim.sandell@nsftele.com
8
9 Description
10 A Thread that performs an Sweep of an interbase database on the fly.
11 The thread can automatically free itself after the sweep is done.
12
13 Note: This can be a lengthy process so make sure you do not interrupt
14 the program in the middle of the sweep. The sweeping process
15 can not be interrupted !!! It makes sense to let it run in the
16 background and free itself if you have a server program !
17
18 Parameters
19 ----------
20 DatabaseName Full : to database
21 DatabaseUsername The name of the user with rights to sweep the db
22 DatabasePassword The password of the user
23 FreeOnTerminate Set this to false if you want to free the thread
24 yourself. Default is TRUE
25 Priority The priority of the thread. Default is tpLower
26
27 Version
28 1.0
29
30 History
31 24.09.2002 - Initial version
32
33 Known issues
34 None so far ...
35
36 Example of usage
37
38 The example below assumes you have included the "IBSweepThread" unit
39 in the uses clause, and that you have a button on a form.
40
41 The Thread must be created and the properties initialized, before the
42 thread can be Resumed.
43
44 procedure TForm1.Button1Click(Sender: TObject);
45 Var
46 IBSweep : TIBSweepThread;
47 begin
48 Try
49 IBSweep := TIBSweepThread.Create( True );
50 IBSweep.DatabaseName := '127.0.0.1:C:\Databases\MyIBDB.GDB';
51 IBSweep.DatabaseUsername := 'SYSDBA';
52 IBSweep.DatabasePassword := 'masterkey';
53 IBSweep.FreeOnTerminate := False; // We want to see the results!
54 IBSweep.Resume;
55 { Wait for it }
56 While Not IBSweep.Terminated do
57 Begin
58 SleepEx(1,True);
59 Application.ProcessMessages;
60 End;
61 { Just make sure the thread is dead }
62 IBSweep.WaitForAndSleep;
63 { Check for success }
64 If IBSweep.ResultState = state_Done then
65 Begin
66 MessageDlg( 'Sweep OK - Time taken: '+
67 IntToStr(IBSweep.ProcessTime)+' ms',
68 mtInformation,[mbOK],0);
69 ShowMessage( IBSweep.SweepResult.Text );
70 End Else MessageDlg('Sweep FAILED',mtError,[mbOK],0);
71 Finally
72 IBSweep.Free;
73 End;
74 end;
75 *)
76 unit IBSweepThread;
77
78 interface
79
80 uses
81 Windows, Messages, SysUtils, Classes,
82 IBServices;
83
84 const
85 state_Idle = $0;
86 state_Initializing = $1;
87 state_Sweeping = $2;
88 state_Done = $3;
89 state_Error = $ - 1;
90
91 type
92 TIBSweepThread = class(TThread)
93 private
94 { Private declarations }
95 protected
96 { Protected declarations }
97 procedure DoSweep;
98 public
99 { Public declarations }
100 DatabaseName: string; // Fully qualifyed name to db
101 DatabaseUsername: string; // Username
102 DatabasePassword: string; // Password
103 Processing: Boolean; // True while processing
104 ResultState: Integer; // See state_xxxx constants
105 ProcessTime: Cardinal; // Milliseconds of the sweep
106
107 property Terminated; // Make the Terminated published
108
109 constructor Create(CreateSuspended: Boolean); virtual;
110 procedure Execute; override;
111 procedure WaitForAndSleep;
112 published
113 { Published declarations }
114 end;
115
116 implementation
117
118 { TIBSweepThread }
119
120 ///////////////////////////////////////////////////////////////////////////////
121 //
122 // Threads Constructor. Allocated objects, and initializes some
123 // variables to the default states.
124 //
125 // Also sets the Priority and FreeOnTreminate conditions.
126 //
127 ///////////////////////////////////////////////////////////////////////////////
128
129 constructor TIBSweepThread.Create(CreateSuspended: Boolean);
130 begin
131 { Override user parameter }
132 inherited Create(True);
133 { Default parameters }
134 FreeOnTerminate := False;
135 Priority := tpLower;
136 { Set variables }
137 Processing := False;
138 ResultState := state_Idle;
139 end;
140
141 ///////////////////////////////////////////////////////////////////////////////
142 //
143 // Threads execute loop. Jumps to the DoWork() procedure every 250 ms
144 //
145 ///////////////////////////////////////////////////////////////////////////////
146
147 procedure TIBSweepThread.Execute;
148 begin
149 try
150 { Perform the Sweep }
151 DoSweep;
152 except
153 on E: Exception do
154 ; // TODO: Execption logging
155 end;
156 { Signal terminated }
157 Terminate;
158 end;
159
160 ///////////////////////////////////////////////////////////////////////////////
161 //
162 // Waits for the Thread to finish. Same as WaitFor, but does not take
163 // 100% CPU time while waiting ...
164 //
165 ///////////////////////////////////////////////////////////////////////////////
166
167 procedure TIBSweepThread.WaitForAndSleep;
168 var
169 H: THandle;
170 D: DWord;
171 begin
172 { Get Handle }
173 H := Handle;
174 { Wait for it to terminate }
175 repeat
176 D := WaitForSingleObject(H, 1);
177 { System Slizes }
178 SleepEx(1, True);
179 until (Terminated) or ((D <> WAIT_TIMEOUT) and (D <> WAIT_OBJECT_0));
180 end;
181
182 ///////////////////////////////////////////////////////////////////////////////
183 //
184 // Makes a sweep of the database specifyed in the properties.
185 //
186 ///////////////////////////////////////////////////////////////////////////////
187
188 procedure TIBSweepThread.DoSweep;
189 var
190 IBSweep: TIBValidationService;
191 SrvAddr: string;
192 DBName: string;
193 begin
194 try
195 { Set Start Time }
196 ProcessTime := GetTickCount;
197 { Extract SrvAddr and DBName from DatabaseName }
198 SrvAddr := DatabaseName;
199 { Correct if Local machine }
200 if Pos(':', SrvAddr) <> 0 then
201 begin
202 Delete(SrvAddr, Pos(':', SrvAddr), Length(SrvAddr));
203 DBName := DatabaseName;
204 Delete(DBName, 1, Pos(':', DBName));
205 end
206 else
207 begin
208 { Must be localhost since Server Address is missing }
209 SrvAddr := '127.0.0.1';
210 DBName := DatabaseName;
211 end;
212 { Set Flags }
213 Processing := True;
214 ResultState := state_Initializing;
215 try
216 { Create IBValidationService }
217 IBSweep := TIBValidationService.Create(nil);
218 IBSweep.Protocol := TCP;
219 IBSweep.LoginPrompt := False;
220 IBSweep.Params.Values['user_name'] := DatabaseUsername;
221 IBSweep.Params.Values['password'] := DatabasePassword;
222 IBSweep.ServerName := SrvAddr;
223 IBSweep.DatabaseName := DBName;
224 IBSweep.Active := True;
225 IBSweep.Options := [SweepDB];
226 try
227 { Start the service }
228 IBSweep.ServiceStart;
229 { Set state }
230 ResultState := state_Sweeping;
231 { Get the Report Lines - No lines in Sweeping but needs to be done }
232 while not IBSweep.Eof do
233 begin
234 IBSweep.GetNextLine;
235 { Wait a bit }
236 Sleep(1);
237 end;
238 finally
239 { Deactive Service }
240 IBSweep.Active := False;
241 end;
242 { Set State to OK }
243 ResultState := state_Done;
244 except
245 on E: Exception do
246 begin
247 { Set State to OK }
248 ResultState := state_Error;
249 end;
250 end
251 finally
252 { Calculate Process Time }
253 ProcessTime := GetTickCount - ProcessTime;
254 { Free objects }
255 if Assigned(IBSweep) then
256 begin
257 if IBSweep.Active then
258 IBSweep.Active := False;
259 IBSweep.Free;
260 IBSweep := nil;
261 end;
262 { Set flag }
263 Processing := False;
264 end;
265 end;
266
267 end.
|