Mega Code Archive
Interbase Sweep on the Fly in a thread
<![CDATA[
Title: Interbase Sweep on the Fly in a thread
Question: 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:
(*
Interbase Sweep Thread
Author
Kim Sandell
Email: kim.sandell@celarius.com
Description
A Thread that performs an Sweep of an interbase database on the fly.
The thread can automatically free itself after the sweep is done.
Note: This can be a lengthy process so make sure you do not interrupt
the program in the middle of the sweep. The sweeping process
can not be interrupted !!! It makes sense to let it run in the
background and free itself if you have a server program !
Parameters
----------
DatabaseName Full hostname:path to database
DatabaseUsername The name of the user with rights to sweep the db
DatabasePassword The password of the user
FreeOnTerminate Set this to false if you want to free the thread
yourself. Default is TRUE
Priority The priority of the thread. Default is tpLower
Version
1.0
History
24.09.2002 - Initial version
Known issues
None so far ...
Example of usage
The example below assumes you have included the "IBSweepThread" unit
in the uses clause, and that you have a button on a form.
The Thread must be created and the properties initialized, before the
thread can be Resumed.
procedure TForm1.Button1Click(Sender: TObject);
Var
IBSweep : TIBSweepThread;
begin
Try
IBSweep := TIBSweepThread.Create( True );
IBSweep.DatabaseName := '127.0.0.1:C:\Databases\MyIBDB.GDB';
IBSweep.DatabaseUsername := 'SYSDBA';
IBSweep.DatabasePassword := 'masterkey';
IBSweep.FreeOnTerminate := False; // We want to see the results!
IBSweep.Resume;
{ Wait for it }
While Not IBSweep.Terminated do
Begin
SleepEx(1,True);
Application.ProcessMessages;
End;
{ Just make sure the thread is dead }
IBSweep.WaitForAndSleep;
{ Check for success }
If IBSweep.ResultState = state_Done then
Begin
MessageDlg( 'Sweep OK - Time taken: '+
IntToStr(IBSweep.ProcessTime)+' ms',
mtInformation,[mbOK],0);
ShowMessage( IBSweep.SweepResult.Text );
End Else MessageDlg('Sweep FAILED',mtError,[mbOK],0);
Finally
IBSweep.Free;
End;
end;
*)
unit IBSweepThread;
interface
uses
Windows, Messages, SysUtils, Classes,
IBServices;
Const
state_Idle = $0;
state_Initializing = $1;
state_Sweeping = $2;
state_Done = $3;
state_Error = $-1;
type
TIBSweepThread = class(TThread)
private
{ Private declarations }
protected
{ Protected declarations }
Procedure DoSweep;
public
{ Public declarations }
DatabaseName : String; // Fully qualifyed name to db
DatabaseUsername : String; // Username
DatabasePassword : String; // Password
Processing : Boolean; // True while processing
ResultState : Integer; // See state_xxxx constants
ProcessTime : Cardinal; // Milliseconds of the sweep
Property Terminated; // Make the Terminated published
Constructor Create( CreateSuspended: Boolean ); Virtual;
Procedure Execute; Override;
Procedure WaitForAndSleep;
published
{ Published declarations }
end;
implementation
{ TIBSweepThread }
///////////////////////////////////////////////////////////////////////////////
//
// Threads Constructor. Allocated objects, and initializes some
// variables to the default states.
//
// Also sets the Priority and FreeOnTreminate conditions.
//
///////////////////////////////////////////////////////////////////////////////
constructor TIBSweepThread.Create(CreateSuspended: Boolean);
begin
{ Override user parameter }
Inherited Create( True );
{ Default parameters }
FreeOnTerminate := False;
Priority := tpLower;
{ Set variables }
Processing := False;
ResultState := state_Idle;
end;
///////////////////////////////////////////////////////////////////////////////
//
// Threads execute loop. Jumps to the DoWork() procedure every 250 ms
//
///////////////////////////////////////////////////////////////////////////////
procedure TIBSweepThread.Execute;
begin
Try
{ Perform the Sweep }
DoSweep;
Except
On E:Exception do ; // TODO: Execption logging
End;
{ Signal terminated }
Terminate;
end;
///////////////////////////////////////////////////////////////////////////////
//
// Waits for the Thread to finish. Same as WaitFor, but does not take
// 100% CPU time while waiting ...
//
///////////////////////////////////////////////////////////////////////////////
procedure TIBSweepThread.WaitForAndSleep;
Var
H : THandle;
D : DWord;
begin
{ Get Handle }
H := Handle;
{ Wait for it to terminate }
Repeat
D := WaitForSingleObject(H, 1);
{ System Slizes }
SleepEx(1,True);
Until (Terminated) OR ((DWAIT_TIMEOUT) AND (DWAIT_OBJECT_0));
end;
///////////////////////////////////////////////////////////////////////////////
//
// Makes a sweep of the database specifyed in the properties.
//
///////////////////////////////////////////////////////////////////////////////
procedure TIBSweepThread.DoSweep;
Var
IBSweep : TIBValidationService;
SrvAddr : String;
DBName : String;
begin
Try
{ Set Start Time }
ProcessTime := GetTickCount;
{ Extract SrvAddr and DBName from DatabaseName }
SrvAddr := DatabaseName;
{ Correct if Local machine }
If Pos(':',SrvAddr)0 then
Begin
Delete( SrvAddr, Pos(':',SrvAddr), Length(SrvAddr) );
DBName := DatabaseName;
Delete( DBName, 1, Pos(':',DBName) );
End Else
Begin
{ Must be localhost since Server Address is missing }
SrvAddr := '127.0.0.1';
DBName := DatabaseName;
End;
{ Set Flags }
Processing := True;
ResultState := state_Initializing;
Try
{ Create IBValidationService }
IBSweep := TIBValidationService.Create( NIL );
IBSweep.Protocol := TCP;
IBSweep.LoginPrompt := False;
IBSweep.Params.Values['user_name'] := DatabaseUsername;
IBSweep.Params.Values['password'] := DatabasePassword;
IBSweep.ServerName := SrvAddr;
IBSweep.DatabaseName := DBName;
IBSweep.Active := True;
IBSweep.Options := [SweepDB];
Try
{ Start the service }
IBSweep.ServiceStart;
{ Set state }
ResultState := state_Sweeping;
{ Get the Report Lines - No lines in Sweeping but needs to be done }
While NOT IBSweep.Eof do
BEGIN
IBSweep.GetNextLine;
{ Wait a bit }
Sleep(1);
END;
Finally
{ Deactive Service }
IBSweep.Active := False;
End;
{ Set State to OK }
ResultState := state_Done;
Except
On E:Exception do
Begin
{ Set State to OK }
ResultState := state_Error;
End;
End
Finally
{ Calculate Process Time }
ProcessTime := GetTickCount-ProcessTime;
{ Free objects }
If Assigned(IBSweep) then
Begin
If IBSweep.Active then IBSweep.Active := False;
IBSweep.Free;
IBSweep := NIL;
End;
{ Set flag }
Processing := False;
End;
end;
end.
]]>