disqlite3_busy_timeout.dpr

来自「DELPHI 访问SQLITE3 数据库的VCL控件」· DPR 代码 · 共 371 行

{ This DISQLite3 demo allows to experiment with read and write locks using two
  threads. The TReaderThread locks the database through a SELECT operation,
  while the TWriterThread tries an INSERT at the same time.

  The TWriterThread sets up a busy timeout to wait for the TReaderThread to
  finish and unlock the database so the TWriterThread can proceed writing
  the data. You can follow this as you watch the output each thread prints
  to the console.

  In the original setup, the TWriterThread waits just long enough for the
  TReaderThread to finish. However, you can change the settings in the const
  section at the very beginning of this file to experiment with different
  scenarios. For example, if you increase the READ_LIMIT constant, TReaderThread
  might take too long for TWriterThread to succeed.  Alternatively, you can cut
  down the WRITE_BUSY_TIMEOUT to achieve the same result. Just play with the
  different values to understand how locking works with DISQLite3.

  Visit the DISQLite3 Internet site for latest information and updates:

    http://www.yunqa.de/delphi/

  Copyright (c) 2006-2007 Ralf Junker, The Delphi Inspiration <[e-mail]>

------------------------------------------------------------------------------ }

program DISQLite3_Busy_Timeout;

{$APPTYPE CONSOLE}
{$I DI.inc}
{$I DISQLite3.inc}

uses
  Windows, SysUtils, Classes,
  DISQLite3Api;

const
  { Modify these constants to experiment with different scenarios. }

  READ_LIMIT = 20; // Default: 20 -- each read takes about 100 ms

  WRITE_BUSY_TIMEOUT = 3000; // Default: 3000 -- busy timeout in milli-seconds.

  WRITE_TRANSACTION_TYPE = 'DEFERRED'; // Default: DEFERRED
  // WRITE_TRANSACTION_TYPE = 'IMMEDIATE';
  // WRITE_TRANSACTION_TYPE = 'EXCLUSIVE';

  {.$DEFINE InsertInTransaction} // Default: Undefined.

  INSERT_COUNT = 25;  // Default: 25 -- numer of records inserted.

type
  //------------------------------------------------------------------------------
  // TTestClass class - performs the tests.
  //------------------------------------------------------------------------------

  TTestClass = class
  private
    FCriticalSection: TRTLCriticalSection;
    FThreadCounter: Cardinal;
    FDatabaseName: AnsiString;
  public
    constructor Create(const ADatabaseName: AnsiString);
    destructor Destroy; override;
    { TThread.OnTerminate does not work in console applications, so we have to
      implement our own thread tracking mechanism. }
    procedure IncThreadCounter;
    procedure DecThreadCounter;
    procedure Execute;
    { Waits till all threads have finished. }
    procedure Wait;

    property DatabaseName: AnsiString read FDatabaseName;
  end;

  //------------------------------------------------------------------------------

  TDISQLite3Thread = class(TThread)
  private
    FDb: TDISQLite3DatabaseHandle;
    FTestClass: TTestClass;
    FVerbose: Boolean;
  protected
    procedure WriteMsg(const AMsg: AnsiString; const AArgs: array of const);
  public
    constructor Create(const ATestClass: TTestClass; const AVerbose: Boolean = False);
    destructor Destroy; override;
    property DB: TDISQLite3DatabaseHandle read FDb;
    property TestClass: TTestClass read FTestClass;
  end;

  //------------------------------------------------------------------------------

  TReaderThread = class(TDISQLite3Thread)
  public
    procedure Execute; override;
  end;

  //------------------------------------------------------------------------------

  TWriterThread = class(TDISQLite3Thread)
  public
    procedure Execute; override;
  end;

  //------------------------------------------------------------------------------

function MakeMethod(const AData, ACode: Pointer): TMethod;
begin
  with Result do begin Data := AData; Code := ACode; end;
end;

//------------------------------------------------------------------------------
// TDISQLite3Thread
//------------------------------------------------------------------------------

constructor TDISQLite3Thread.Create(const ATestClass: TTestClass; const AVerbose: Boolean = False);
begin
  ATestClass.IncThreadCounter;
  sqlite3_check(sqlite3_open(PAnsiChar(ATestClass.DatabaseName), @FDb), FDb);
  sqlite3_exec_fast(FDb, 'PRAGMA synchronous=off'); // Be faster and less safe - this is just a demo ;-)
  FTestClass := ATestClass;
  FVerbose := AVerbose;
  FreeOnTerminate := True;
  inherited Create(False);
end;

//------------------------------------------------------------------------------

destructor TDISQLite3Thread.Destroy;
begin
  sqlite3_check(sqlite3_close(FDb), FDb);
  inherited;
end;

//------------------------------------------------------------------------------

procedure TDISQLite3Thread.WriteMsg(const AMsg: AnsiString; const AArgs: array of const);
begin
  if FVerbose then
    WriteLn(Format(AMsg, AArgs));
end;

//------------------------------------------------------------------------------
// TReaderThread
//------------------------------------------------------------------------------

procedure TReaderThread.Execute;
var
  SQL: AnsiString;
  Stmt: TDISQLite3StatementHandle;
begin
  try
    ReturnValue := SQLITE_OK;
    try
      { Run a query which takes about 3 seconds to complete. The database
        will be locked as long as the query executes. }
      SQL := 'SELECT t FROM Test LIMIT ' + IntToStr(READ_LIMIT) + ';';
      sqlite3_check(sqlite3_prepare_v2(DB, PAnsiChar(SQL), Length(SQL), @Stmt, nil), DB);
      try
        while not Terminated and (sqlite3_check(sqlite3_step(Stmt), DB) = SQLITE_ROW) do
          begin
            WriteLn('Read ', sqlite3_column_int(Stmt, 0));
            Sleep(100);
          end;
      finally
        sqlite3_check(sqlite3_finalize(Stmt), DB);
      end;
    except
      on e: ESQLite3 do
        ReturnValue := sqlite3_errcode(DB)
      else
        ReturnValue := SQLITE_ERROR;
    end;
  finally
    TestClass.DecThreadCounter;
  end;
end;

//------------------------------------------------------------------------------
// TWriterThread
//------------------------------------------------------------------------------

procedure TWriterThread.Execute;
var
  e, i: Integer;
  Stmt: TDISQLite3StatementHandle;
begin
  try
    ReturnValue := SQLITE_OK;
    try
      { Set a busy timeout of 3000 ms, equivalent to 3 seconds. If subsequent
        commands are executed while the database is locked by another thread
        (like TReaderThread in this example), DISQLite3 will keep on retrying
        the command for 3 seconds before giving up and returning SQLITE_LOCKED. }
      sqlite3_busy_timeout(FDb, WRITE_BUSY_TIMEOUT);

      {$IFDEF InsertInTransaction}
      WriteMsg('  BEGINNING %s TRANSACTION ...', [WRITE_TRANSACTION_TYPE]);
      sqlite3_exec_fast(DB, 'BEGIN ' + WRITE_TRANSACTION_TYPE + ';');
      WriteMsg('  BEGINNING %s TRANSACTION ... Done', [WRITE_TRANSACTION_TYPE]);
      try
        {$ENDIF InsertInTransaction}
        { Create a new table ... }
        sqlite3_exec_fast(FDb, 'CREATE TABLE IF NOT EXISTS Test (t INTEGER);');

        e := sqlite3_prepare_v2(DB, 'INSERT INTO test VALUES (?);', -1, @Stmt, nil);
        try
          if e = SQLITE_OK then
            begin
              i := 0;
              repeat
                WriteMsg('  Inserting %d ...', [i]);
                sqlite3_check(sqlite3_bind_int(Stmt, 1, i), DB);
                sqlite3_check(sqlite3_step(Stmt), DB);
                WriteMsg('  Inserting %d ... Done', [i]);
                sqlite3_check(sqlite3_reset(Stmt), DB);
                Inc(i);
              until Terminated or (i >= INSERT_COUNT);
            end;
        finally
          sqlite3_check(sqlite3_finalize(Stmt), DB);
        end;
        {$IFDEF InsertInTransaction}
      finally
        WriteMsg('  COMMITTING TRANSACTION ...', []);
        sqlite3_exec_fast(DB, 'COMMIT TRANSACTION');
        WriteMsg('  COMMITTING TRANSACTION ... Done', []);
      end;
      {$ENDIF InsertInTransaction}
    except
      on e: ESQLite3 do
        begin
          ReturnValue := sqlite3_errcode(DB);
          if e.ErrorCode = sqlite_busy then
            WriteLn('  INSERT timed out!')
          else
            WriteLn(e.Message);
        end
      else
        ReturnValue := SQLITE_ERROR;
    end;
  finally
    TestClass.DecThreadCounter;
  end;
end;

//------------------------------------------------------------------------------
// TTestClass class
//------------------------------------------------------------------------------

constructor TTestClass.Create(const ADatabaseName: AnsiString);
begin
  inherited Create;
  FDatabaseName := ADatabaseName;
  { Create critical section and event object to monitor multiple threads. }
  InitializeCriticalSection(FCriticalSection);
end;

//------------------------------------------------------------------------------

destructor TTestClass.Destroy;
begin
  DeleteCriticalSection(FCriticalSection); ;
  inherited;
end;

//------------------------------------------------------------------------------

procedure TTestClass.DecThreadCounter;
begin
  EnterCriticalSection(FCriticalSection);
  if FThreadCounter > 0 then
    begin
      Dec(FThreadCounter);
    end;
  LeaveCriticalSection(FCriticalSection);
end;

//------------------------------------------------------------------------------

procedure TTestClass.Execute;
var
  DB: TDISQLite3DatabaseHandle;
  i, v: Integer;
  SQL: AnsiString;
  Stmt: TDISQLite3StatementHandle;
begin
  { Always start over with an empty database. }
  SysUtils.DeleteFile(FDatabaseName);
  { ... and insert some data. We use the thread here just for convenience. }
  TWriterThread.Create(Self);
  Wait;

  { Here starts the test: We create two threads: }

  { Thread 1: Initializes a prolonged reading, which locks the database. The
    thread will free itself automatically when terminated.}
  TReaderThread.Create(Self);
  { Wait a bit to simulate a writing when tread one is already in the middle of
    the reading. }
  Sleep(300);
  { Thread 2: Tries to write to the database while it is locked because thread 1
    is reading from it. The thread will free itself automatically when
    terminated. }
  TWriterThread.Create(Self, True);
  Wait;

  { Check if all values were correctly inserted into the database. }
  sqlite3_check(sqlite3_open(PAnsiChar(DatabaseName), @DB), DB);
  try
    i := 0;
    SQL := 'SELECT t FROM Test ORDER BY 1;';
    sqlite3_check(sqlite3_prepare_v2(DB, PAnsiChar(SQL), Length(SQL), @Stmt, nil), DB);
    try
      while sqlite3_check(sqlite3_step(Stmt), DB) = SQLITE_ROW do
        begin
          v := sqlite3_column_int(Stmt, 0);
          if v <> i div 2 then
            begin
              WriteLn('ERROR');
              Break;
            end;
          Inc(i);
        end;
    finally
      sqlite3_check(sqlite3_finalize(Stmt), DB);
    end;
  finally
    sqlite3_check(sqlite3_close(DB), DB);
  end;

  if i <> 2 * INSERT_COUNT then
    WriteLn('ERROR: ', i, ' records found, ', 2 * INSERT_COUNT, ' expexted');
end;

//------------------------------------------------------------------------------

procedure TTestClass.IncThreadCounter;
begin
  EnterCriticalSection(FCriticalSection);
  Inc(FThreadCounter);
  LeaveCriticalSection(FCriticalSection);
end;

//------------------------------------------------------------------------------

procedure TTestClass.Wait;
begin
  while FThreadCounter > 0 do
    Sleep(10);
end;

//------------------------------------------------------------------------------

var
  t: TTestClass;

begin
  t := TTestClass.Create('test.db3');
  try
    t.Execute;

    WriteLn;
    WriteLn('Done - Press ENTER to Exit');
    ReadLn;
  finally
    t.Free;
  end;
end.