Visit our Sponsor   Visit our Sponsor
delphi3000.com - the free delphi knowledge platform
delphi3000.com - the free delphi knowledge platform
500 Users Online NOW
Have a look at your member-status

connecting people's knowledge


  - Recent ArticlesRSS feed for Recent Articles on delphi3000.com
  - List of All Articles
  - Top Viewed Articles
  - Articles (+Attachem.)
  - Articles Of Interest
  - Categories
  - Top Uploader
  - Search
  - Index

  - My Home
  - Submit an Article
  - My Articles
  - My Personal Data
  - My Bookmarks
  - Activities
  - Login/Logout

  - Sign Up
  - Why Sign Up
  - Newsletter

  - Press
  - Advertise

  - Contact
  - Feedback





Community
Borland
ClubeDelphi
Dr. Bob
UK-BUG
Delphi Meetings
Planeta Delphi



Loremo - the 1.5 liter car coming in 2009




Startblatt.de






Share this article with friendsShare this article with friends
Rate this articleRate this article - to keep the quality of delphi3000.com !
Comment this article or read through previous comments (0)


Interbase Sweep on the Fly in a threadFormat this article printer-friendly!Bookmark function is only available for registered users!
Make interbase database sweeps on the fly, in a background thread
Product:
Delphi 5.x (or higher)
Category:
Database-SQL
Skill Level:
Scoring:
Last Update:
08/04/2004
Search Keys:
delphi delphi3000 article borland vcl code-snippet Interbase database automated sweep thread server
Times Scored:
5
Visits:
4176
Uploader: Kim Sandell
Company: Celarius Oy
Reference: N/A
 
Question/Problem/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.





Please rate this article!
Skill level:
BeginnerExpert

Useful:
No!Very!

Overall rating:
PoorExcellent



Comments to this article
Write a new comment













 
Sign up to consume product discounts for Bronze memberships !

read more


  Visit our Sponsor

 

  Community Ad of
M. Maes
 
   














 







     
  Copyright © 2000 - 2007 delphi3000.com - All rights reserved. Terms of use. || Privacy
delphi3000.com is a service by bluestep.com IT-Services GmbH (Vienna)