Interbase Sweep on the Fly in a thread

Problem/Question/Abstract:

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@nsftele.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 : 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 ((D <> WAIT_TIMEOUT) and (D <> WAIT_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.