{ This example project shows how to realize a full text search (FTS) utility
  with DISQLite3.

  The application includes both indexing and searching of *.pas or *.txt
  documents using the internal DISQLite3 full text search.

  To experience full text search you first need build the full text search
  index. Specify the path, extension, and the FTS module and click Index to
  add files to the full text index.

  After indexing, searching is immediately available, even if the application
  is restarted. Simply enter the search term and press 'Enter' to run the query.

  Visit the DISQLite3 Internet site for latest information and updates:

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

  Copyright (c) 2005-2009 Ralf Junker, The Delphi Inspiration <delphi@yunqa.de>

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

unit DISQLite3_Full_Text_Search_Form_Main;

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

{$DEFINE DI_Debug} // Default: Off.

interface

uses
  DISystemCompat, Classes, Controls, Forms, StdCtrls, ComCtrls, ExtCtrls,
  DISQLite3Database;

type
  TOffsetInfo = record
    o: Integer; // Offset
    l: Integer; // Length
  end;
  TOffsetInfoArray = array of TOffsetInfo;

  TfrmFTS = class(TForm)
    pnlIndex: TPanel;
    edtIndexPath: TEdit;
    btnAddToIndex: TButton;
    lblIndexPath: TLabel;
    btnIndexPathSelect: TButton;
    cbxRecurse: TCheckBox;
    pnlSearch: TPanel;
    lblSearchExpression: TLabel;
    edtSearch: TEdit;
    btnSearch: TButton;
    pnlIndexCaption: TPanel;
    pnlSearchCaption: TPanel;
    pnlResults: TPanel;
    lbxResults: TListBox;
    memoContents: TMemo;
    StatusBar: TStatusBar;
    Splitter1: TSplitter;
    cbxModules: TComboBox;
    lblModule: TLabel;
    cbxExtensions: TComboBox;
    pnlSearchResult: TPanel;
    cbxWordWrap: TCheckBox;
    btnNext: TButton;
    btnPrevious: TButton;
    btnFirst: TButton;
    btnLast: TButton;
    cbxTokenizers: TComboBox;
    lblTokenizer: TLabel;
    btnClearIndex: TButton;
    procedure Form_Create(Sender: TObject);
    procedure Form_Destroy(Sender: TObject);
    procedure btnAddToIndex_Click(Sender: TObject);
    procedure btnIndexPathSelect_Click(Sender: TObject);
    procedure btnSearch_Click(Sender: TObject);
    procedure btnNext_Click(Sender: TObject);
    procedure btnPrevious_Click(Sender: TObject);
    procedure btnFirst_Click(Sender: TObject);
    procedure btnLast_Click(Sender: TObject);
    procedure cbxWordWrap_Click(Sender: TObject);
    procedure lbxResults_Click(Sender: TObject);
    procedure lbxResults_DblClick(Sender: TObject);
    procedure edtSearch_KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure memoContents_KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure btnClearIndex_Click(Sender: TObject);
  private
    FDb: TDISQLite3Database;
    FCurrentContentID: Int64;
    FCurrentOffsets: TOffsetInfoArray;
    FCurrentOffsetIdx: Integer;
    FCurrentSearch: UnicodeString;
    procedure CreateDatabase;
    procedure CloseDatabase;
    function HighlightCurrent: Boolean;
    procedure SetStatus(
      const StrOne: String = '';
      const StrTwo: String = '';
      const StrThree: String = '';
      const StrFour: String = '';
      const UpdateOne: Boolean = True;
      const UpdateTwo: Boolean = True;
      const UpdateThree: Boolean = True;
      const UpdateFour: Boolean = True);
  public
    procedure AddFiles(
      aDir: String;
      const ARecurse: Boolean;
      const ATokenizer: String);
    procedure ClearIndex;
    procedure ClearResults;
    procedure EnableControls(const AValue: Boolean);
    function HighlightFirst: Boolean;
    function HighlightLast: Boolean;
    function HighlightNext: Boolean;
    function HighlightPrevious: Boolean;
    procedure SearchFiles(const ASearch: WideString);
    procedure ShowContents(const FileID: Integer);
  end;

var
  frmFTS: TfrmFTS;

const
  APP_TITLE = 'DISQLite3' + {$IFDEF DISQLite3_Personal} ' Personal' + {$ENDIF} ': Full Text Search Demo';

implementation

uses
  Windows, Messages, ShellAPI, SysUtils, FileCtrl, Dialogs,

  DISQLite3Api, DISQLite3PascalTokenizer;

{$R *.dfm}

const
  DATABASE_NAME = 'FTS.db3';
  FTS_TABLE = 'FTS';

  //------------------------------------------------------------------------------
  // Basic database functions
  //------------------------------------------------------------------------------

{ Open an existing database or create a new one, if it does not exist. }
procedure TfrmFTS.CreateDatabase;
begin
  FDb := TDISQLite3Database.Create(nil);
  FDb.DatabaseName := DATABASE_NAME;
  try
    { Open an existing database. This raises an exception if the database does
      not exist. The except section below catches this exception and creates a
      new database. }
    FDb.Open;
  except
    FDb.CreateDatabase;
    { Do not use the old database format. The new file format supports
      descending indexes, is more compact and creates smaller databases. }
    FDb.Execute16('PRAGMA legacy_file_format=OFF;');
  end;

  { Register the Full Text Search modules with the database handle. FTS will not
    be available unless their modules are registered. FTS module are independend
    of each other and must be egistered separately, so applications can choose
    which ones to support. Unused modules are not linked into the application! }

  {$IFDEF SQLITE_ENABLE_FTS1}
  sqlite3_check(sqlite3Fts1Init(FDb.Handle), FDb.Handle);
  {$ENDIF}

  {$IFDEF SQLITE_ENABLE_FTS2}
  sqlite3_check(sqlite3Fts2Init(FDb.Handle), FDb.Handle);
  sqlite3_check(sqlite3Fts2RegisterTokenizer(FDb.Handle, 'pascal', sqlite3Fts2PascalTokenizerModule));
  {$ENDIF SQLITE_ENABLE_FTS2}

  {$IFDEF SQLITE_ENABLE_FTS3}
  sqlite3_check(sqlite3Fts3Init(FDb.Handle), FDb.Handle);
  sqlite3_check(sqlite3Fts3RegisterTokenizer(FDb.Handle, 'pascal', sqlite3Fts2PascalTokenizerModule));
  {$ENDIF SQLITE_ENABLE_FTS2}
end;

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

procedure TfrmFTS.CloseDatabase;
begin
  FDb.Free;
end;

//------------------------------------------------------------------------------
// Full Text index and search functions
//------------------------------------------------------------------------------

procedure TfrmFTS.AddFiles(
  aDir: String;
  const ARecurse: Boolean;
  const ATokenizer: String);

{$IFNDEF COMPILER_6_UP}
{ Mimic function not available before Delphi 6. }
  function IncludeTrailingPathDelimiter(const s: AnsiString): AnsiString;
  begin
    Result := s;
    if (Result = '') or (Result[Length(Result)] <> '\') then
      Result := Result + '\';
  end;
  {$ENDIF !COMPILER_6_UP}

  function KiloByteText(const ABytes: Int64): String;
  begin
    Result := IntToStr((ABytes + 1023) div 1024) + ' KB';
  end;

  { Loads the contents of a file into a string. }
  function ReadString(const FileName: String; var s: AnsiString): Boolean;
  var
    FileHandle: THandle;
    FileSize, NumberOfBytesRead: DWORD;
  begin
    FileHandle := CreateFile(PChar(FileName), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL or FILE_FLAG_SEQUENTIAL_SCAN, 0);
    Result := FileHandle <> INVALID_HANDLE_VALUE;
    if Result then
      begin
        FileSize := GetFileSize(FileHandle, nil);
        Result := FileSize <> $FFFFFFFF;
        if Result then
          begin
            SetString(s, nil, FileSize);
            Result := ReadFile(FileHandle, Pointer(s)^, FileSize, NumberOfBytesRead, nil) and (FileSize = NumberOfBytesRead);
            if not Result then
              SetLength(s, NumberOfBytesRead);
          end;
        Result := CloseHandle(FileHandle) and Result;
      end;
  end;

var
  StmtContent, StmtFiles: TDISQLite3Statement;
  Extension: String;
  TC: Cardinal;
  TotalFiles, TotalSize: Int64;

  function GetTickCountDiff: Cardinal;
  begin
    Result := GetTickCount - TC;
    if Result = 0 then
      Result := 1;
  end;

  { Scans a directory (recursively) and adds matches to the database. }
  procedure InternalAdd(const aDir: String);
  var
    FN: String;
    s: AnsiString;
    SR: TSearchRec;
  begin
    if FindFirst(aDir + Extension, faAnyFile, SR) = 0 then
      begin
        repeat
          FN := aDir + SR.Name;

          if ReadString(FN, s) then
            begin
              Inc(TotalFiles); Inc(TotalSize, Length(s));
              SetStatus(
                IntToStr(TotalFiles) + ' Files',
                KiloByteText(TotalSize),
                KiloByteText(TotalSize * 1000 div GetTickCountDiff) + ' / sec',
                FN);

              StmtContent.Bind_Str16(1, UnicodeString(s));
              StmtContent.Step;
              StmtContent.Reset;

              StmtFiles.Bind_Int64(1, FDb.LastInsertRowID);
              StmtFiles.Bind_Str16(2, FN);
              StmtFiles.Step;
              StmtFiles.Reset;
            end;
        until FindNext(SR) <> 0;
        FindClose(SR);
      end;

    if ARecurse and (FindFirst(aDir + '*', faDirectory, SR) = 0) then
      begin
        repeat
          if (SR.Name <> '.') and (SR.Name <> '..') then
            InternalAdd(aDir + SR.Name + '\');
        until FindNext(SR) <> 0;
        FindClose(SR);
      end;
  end;

var
  b: Boolean;
begin
  EnableControls(False);
  try
    ClearResults;

    {.$DEFINE SQLITE_OMIT_PAGER_PRAGMAS}
    {$IFDEF SQLITE_OMIT_PAGER_PRAGMAS}

    ShowMessage(
      'PRAGMAs to speed up indexing are not available in DISQLite3 Personal:' +
      #13#10 + #13#10 + #13#10 +
      '"PRAGMA synchronous=off;"' +
      #13#10 + #13#10 +
      'With the default synchronous=full, the database will pause at critical ' +
      'moments to make sure that all data has successfully been written to the ' +
      'disk surface. This prevents data loss, even if the operating system ' +
      'crashes or the computer loses power, but slows down indexing significantly.' +
      #13#10 + #13#10 +
      '"PRAGMA synchronous=off;" is available with DISQLite3 Pro.' +
      #13#10 + #13#10 +
      'With synchronous=off, the database continues without pausing as soon as ' +
      'it has handed data off to the operating system. This carries the small ' +
      'risk of data loss should the operating system ever crash or the computer ' +
      'lose power. On the other hand, indexing is as much as 50 times faster ' +
      'with synchronous=off.' +
      #13#10 + #13#10 +
      'Only indexing is affected by the synchronous state. Searching is ' +
      'equally fast with DISQLite3 Pro and Personal.' +
      #13#10 + #13#10 + #13#10 +
      '"PRAGMA locking_mode=exclusive;"' +
      #13#10 + #13#10 +
      'Compared to the default locking_mode=normal, exclusive access saves a ' +
      'small number of filesystem operations.');

    {$ELSE SQLITE_OMIT_PAGER_PRAGMAS}

    FDb.Execute16('PRAGMA synchronous=off;'); // For speed!

    { Set database exclusive locking mode. This saves a small number of
      filesystem operations by optimizations enabled in this mode. }
    FDb.Execute16('PRAGMA locking_mode=exclusive;');
    try
      {$ENDIF SQLITE_OMIT_PAGER_PRAGMAS}

      { Test if tables exist already. CREATE VIRTUAL TABLE does not yet support
        the IF NOT EXISTS option. }
      if not (sqlite3_get_boolean(FDb.Handle,
        'SELECT 1 FROM sqlite_master WHERE ' +
        'type=''table'' AND name=''' + FTS_TABLE + '''', b) = SQLITE_OK) or
        not b then
        begin
          SetStatus('', '', '', 'Creating new tables ...');

          { Create FTS tables:
              * FTS:       stores the file's contents and word index
              * FTS_Files: stores the names of the files indexed }
          case cbxModules.ItemIndex of
            0: // FTS 1
              FDb.Execute16(
                'CREATE VIRTUAL TABLE IF NOT EXISTS "' + FTS_TABLE + '" ' +
                'USING FTS1(Content, Tokenize ' + ATokenizer + ')');
            1: // FTS 2
              FDb.Execute16(
                'CREATE VIRTUAL TABLE "' + FTS_TABLE + '" ' +
                'USING FTS2(Content, Tokenize ' + ATokenizer + ')');
            2: // FTS 3
              FDb.Execute16(
                'CREATE VIRTUAL TABLE "' + FTS_TABLE + '" ' +
                'USING FTS3(Content, Tokenize ' + ATokenizer + ')');
          end;

          FDb.Execute16('CREATE TABLE "' + FTS_TABLE + '_Files" ("FileID" INTEGER PRIMARY KEY, "FileName" TEXT);');
        end;

      TC := GetTickCount;

      FDb.StartTransaction; // For speed!
      try
        { Prepare insertion statements for fastest indexing performance. }
        StmtContent := FDb.Prepare16('INSERT INTO "' + FTS_TABLE + '" ("Content") VALUES (?);');
        StmtFiles := FDb.Prepare16('INSERT INTO "' + FTS_TABLE + '_Files" ("FileID", "FileName") VALUES (?,?);');
        try
          aDir := ExpandFileName(aDir);
          aDir := IncludeTrailingPathDelimiter(aDir);
          Extension := cbxExtensions.Text;

          TotalFiles := 0; TotalSize := 0;
          { Now scan the directory and add files (recursively). }
          InternalAdd(aDir);
        finally
          StmtFiles.Free;
          StmtContent.Free;
        end;

        SetStatus('', '', '', 'Committing changes ...', False, False, False);

        FDb.Commit;

        SetStatus(
          IntToStr(TotalFiles) + ' Files',
          KiloByteText(TotalSize),
          KiloByteText(TotalSize * 1000 div GetTickCountDiff) + ' / sec',
          'Indexing done');
      except
        { In case of errors, rollback changes and raise the error. }
        // SetStatus('', '', '', 'Indexing Error - rolling back changes');
        FDb.Rollback;
        // SetStatus('', '', '', 'Indexing Error - changes rolled back');
        raise;
      end;

      {$IFNDEF SQLITE_OMIT_PAGER_PRAGMAS}
    finally
      { Indexing is done, so switch locking mode back to normal. This allows
        other applications to access the database again. }
      FDb.Execute16('PRAGMA locking_mode=normal;');
      { Access the database to enable the new locking mode. }
      FDb.Execute16('SELECT 0 FROM ' + SQLITE_MASTER_QUOTED + ';');
    end;
    {$ENDIF !SQLITE_OMIT_PAGER_PRAGMAS}

  finally
    EnableControls(True);
  end;
end;

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

procedure TfrmFTS.ClearIndex;
begin
  ClearResults;

  SetStatus('', '', '', 'Deleting old contents ...');

  {$IFNDEF SQLITE_OMIT_PAGER_PRAGMAS}

  FDb.Execute16('PRAGMA synchronous=off;'); // For speed!

  { Set database exclusive locking mode. This saves a small number of
    filesystem operations by optimizations enabled in this mode. }
  FDb.Execute16('PRAGMA locking_mode=exclusive;');
  try
    {$ENDIF SQLITE_OMIT_PAGER_PRAGMAS}

    { Drop all tables related to FTS. }

    FDb.Execute16('DROP TABLE IF EXISTS "' + FTS_TABLE + '";');

    {$IFDEF SQLITE_ENABLE_FTS1}
    FDb.Execute16('DROP TABLE IF EXISTS "' + FTS_TABLE + '_Content";');
    FDb.Execute16('DROP TABLE IF EXISTS "' + FTS_TABLE + '_Term";'); // FTS1
    {$ENDIF}

    {$IFDEF SQLITE_ENABLE_FTS2}
    FDb.Execute16('DROP TABLE IF EXISTS "' + FTS_TABLE + '_Content";');
    FDb.Execute16('DROP TABLE IF EXISTS "' + FTS_TABLE + '_SegDir";'); // FTS2
    FDb.Execute16('DROP TABLE IF EXISTS "' + FTS_TABLE + '_Segments";'); // FTS2
    {$ENDIF}

    {$IFDEF SQLITE_ENABLE_FTS3}
    FDb.Execute16('DROP TABLE IF EXISTS "' + FTS_TABLE + '_Content";');
    FDb.Execute16('DROP TABLE IF EXISTS "' + FTS_TABLE + '_SegDir";'); // FTS3
    FDb.Execute16('DROP TABLE IF EXISTS "' + FTS_TABLE + '_Segments";'); // FTS3
    {$ENDIF}

    FDb.Execute16('DROP TABLE IF EXISTS "' + FTS_TABLE + '_Files";');

    SetStatus;

    {$IFNDEF SQLITE_OMIT_PAGER_PRAGMAS}
  finally
    { Indexing is done, so switch locking mode back to normal. This allows
      other applications to access the database again. }
    FDb.Execute16('PRAGMA locking_mode=normal;');
    { Access the database to enable the new locking mode. }
    FDb.Execute16('SELECT 0 FROM ' + SQLITE_MASTER_QUOTED + ';');
  end;
  {$ENDIF !SQLITE_OMIT_PAGER_PRAGMAS}
end;

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

procedure TfrmFTS.SearchFiles(const ASearch: WideString);
var
  Stmt: TDISQLite3Statement;
  TC: Cardinal;
begin
  EnableControls(False);
  try
    FCurrentSearch := ASearch;
    ClearResults;

    TC := GetTickCount;

    try
      { Prepare the full text search statement. It returns the FileName and the FileID. }
      Stmt := FDb.Prepare16(
        'SELECT FileName, FileID FROM ' + FTS_TABLE + ', ' + FTS_TABLE + '_Files ' +
        'WHERE ' + FTS_TABLE + '.RowID = ' + FTS_TABLE + '_Files.FileID AND ' +
        FTS_TABLE + ' MATCH ?;');
    except
      on e: ESQLite3 do
        begin
          MessageDlg(e.Message + #13#10#13#10 + 'Did you already run the indexer which sets up the required tables?', mtError, [mbOK], 0);
          Exit;
        end;
    else
      raise;
    end;

    try
      lbxResults.Items.BeginUpdate;
      Stmt.Bind_Str16(1, ASearch);

      while Stmt.Step = SQLITE_ROW do
        begin
          { Iterate over all match results and add the FileNames and FileIDs to
            the listbox. }
          lbxResults.Items.AddObject(
            Stmt.Column_Str16(0), // The FileName
            TObject(Stmt.Column_Int(1)) // The FileID
            );
        end;

    finally
      lbxResults.Items.EndUpdate;
      Stmt.Free;
    end;

    SetStatus(
      IntToStr(lbxResults.Items.Count) + ' Found',
      IntToStr(GetTickCount - TC) + ' ms',
      '', '');

    lbxResults.ItemIndex := 0;
    lbxResults_Click(nil);
  finally
    EnableControls(True);
  end;
end;

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

{ Converts an Offset string to an array of TOffsetInfo. Takes care to convert
  UTF-8 byte positions to WideString character indexes. Therfore, the
  corresponding Content string must be passed as well. }
function DecodeOffsets(const Offsets: Utf8String; const Content: UnicodeString): TOffsetInfoArray;
var
  OffsetsPtr: PUtf8Char; OffsetsLen: Integer;

  { Skips whitespace and converts digits to integer.
    -1 is returned on error or end of Offsets srting. }
  function ReadNext: Integer;
  begin
    while (OffsetsLen > 0) and (OffsetsPtr^ = #32) do
      begin
        Inc(OffsetsPtr);
        Dec(OffsetsLen);
      end;

    if (OffsetsLen > 0) and (OffsetsPtr^ in ['0'..'9']) then
      begin
        Result := 0;
        repeat
          Result := Result * 10;
          Inc(Result, Ord(OffsetsPtr^) - Ord('0'));
          Inc(OffsetsPtr);
          Dec(OffsetsLen);
        until (OffsetsLen <= 0) or not (OffsetsPtr^ in ['0'..'9'])
      end
    else
      Result := -1;
  end;

var
  ContentPtr: PWideChar; ContentLen: Integer;
  i, CharLength, CharOffset, LastMatchOffset, MatchDelta, MatchOffset, MatchLength: Integer;
begin
  // Determine number of offsets and allocate result array accordingly.
  i := 0;
  OffsetsPtr := PAnsiChar(Offsets); OffsetsLen := Length(Offsets);
  while ReadNext >= 0 do
    Inc(i);
  SetLength(Result, i div 4);

  ContentPtr := PWideChar(Content); ContentLen := Length(Content);
  OffsetsPtr := PUtf8Char(Offsets); OffsetsLen := Length(Offsets);
  i := 0; CharOffset := 0; LastMatchOffset := 0;

  repeat
    if ReadNext < 0 then Break; // Skip index of the column containing the match.
    if ReadNext < 0 then Break; // Skip term in the query expression which was matched.

    MatchOffset := ReadNext;
    if MatchOffset < 0 then Break;

    MatchLength := ReadNext;
    if MatchLength < 0 then Break;

    MatchDelta := MatchOffset - LastMatchOffset;
    LastMatchOffset := MatchOffset + MatchLength;

    { Convert UTF-8 byte offset to character offset. }
    while (ContentLen > 0) and (MatchDelta > 0) do
      begin
        case Ord(ContentPtr^) of
          $0000..$007F: Dec(MatchDelta);
          $0080..$07FF: Dec(MatchDelta, 2);
        else
          Dec(MatchDelta, 3);
        end;
        Inc(CharOffset);
        Inc(ContentPtr); Dec(ContentLen);
      end;
    Result[i].o := CharOffset;

    { Convert UTF-8 byte length to character length. }
    CharLength := 0;
    while (ContentLen > 0) and (MatchLength > 0) do
      begin
        case Ord(ContentPtr^) of
          $0000..$007F: Dec(MatchLength);
          $0080..$07FF: Dec(MatchLength, 2);
        else
          Dec(MatchLength, 3);
        end;
        Inc(CharLength);
        Inc(ContentPtr); Dec(ContentLen);
      end;
    Result[i].l := CharLength;

    Inc(CharOffset, CharLength);
    Inc(i);
  until False;
end;

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

{ Show the document contents of a particular match and initialize the
  highlighting array to quickly navigate between the document's matches. }
procedure TfrmFTS.ShowContents(const FileID: Integer);
var
  Content: WideString;
  Stmt: TDISQLite3Statement;
begin
  EnableControls(False);
  try
    FCurrentContentID := FileID;

    Stmt := FDb.Prepare16(
      'SELECT Content, Offsets (' + FTS_TABLE + ') FROM ' + FTS_TABLE + ' ' +
      'WHERE +RowID = ? AND Content Match (?);');
    try
      Stmt.Bind_Int(1, FileID);
      Stmt.Bind_Str16(2, FCurrentSearch);
      if Stmt.Step = SQLITE_ROW then
        begin
          Content := Stmt.Column_Str16(0);
          { Call TMemo.Clear first to avoid time consuming comparison of old
            and new text when writing to TMemo.Text. }
          memoContents.Clear; memoContents.Text := Content;
          { Load match offsets into array. }
          FCurrentOffsets := DecodeOffsets(Stmt.Column_Str(1), Content);
          SetStatus('', '', '', IntToStr(Length(FCurrentOffsets)) + ' hits in document', False, False, False);
          FCurrentOffsetIdx := -1;
        end
    finally
      Stmt.Free;
    end;

    HighlightFirst;
  finally
    EnableControls(True);
  end;
end;

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

function TfrmFTS.HighlightCurrent: Boolean;
begin
  if FCurrentOffsetIdx < 0
    then FCurrentOffsetIdx := 0;
  if FCurrentOffsetIdx >= Length(FCurrentOffsets) then
    FCurrentOffsetIdx := Length(FCurrentOffsets) - 1;

  Result := (FCurrentOffsetIdx >= 0);
  if Result then
    with FCurrentOffsets[FCurrentOffsetIdx] do
      begin
        memoContents.SelStart := o;
        memoContents.SelLength := l;
        SetStatus('', '', 'hit ' + IntToStr(FCurrentOffsetIdx + 1), '', False, False, True, False);
      end;
end;

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

function TfrmFTS.HighlightFirst: Boolean;
begin
  FCurrentOffsetIdx := 0;
  Result := HighlightCurrent;
end;

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

function TfrmFTS.HighlightLast: Boolean;
begin
  FCurrentOffsetIdx := Length(FCurrentOffsets) - 1;
  Result := HighlightCurrent;
end;

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

function TfrmFTS.HighlightNext: Boolean;
begin
  Inc(FCurrentOffsetIdx);
  Result := HighlightCurrent;
end;

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

function TfrmFTS.HighlightPrevious: Boolean;
begin
  Dec(FCurrentOffsetIdx);
  Result := HighlightCurrent;
end;

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

procedure TfrmFTS.ClearResults;
begin
  lbxResults.Clear;
  memoContents.Clear;
  SetLength(FCurrentOffsets, 0);
  FCurrentOffsetIdx := -1;
end;

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

procedure TfrmFTS.EnableControls(const AValue: Boolean);
begin
  btnAddToIndex.Enabled := AValue;
  btnClearIndex.Enabled := AValue;
  btnSearch.Enabled := AValue;

  btnFirst.Enabled := AValue;
  btnPrevious.Enabled := AValue;
  btnNext.Enabled := AValue;
  btnLast.Enabled := AValue;
end;

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

procedure TfrmFTS.SetStatus(
  const StrOne: String = '';
  const StrTwo: String = '';
  const StrThree: String = '';
  const StrFour: String = '';
  const UpdateOne: Boolean = True;
  const UpdateTwo: Boolean = True;
  const UpdateThree: Boolean = True;
  const UpdateFour: Boolean = True);
begin
  with StatusBar.Panels do
    begin
      if UpdateOne then Items[0].Text := StrOne;
      if UpdateTwo then Items[1].Text := StrTwo;
      if UpdateThree then Items[2].Text := StrThree;
      if UpdateFour then Items[3].Text := StrFour;
    end;
  Application.ProcessMessages;
end;

//------------------------------------------------------------------------------
// Form and Control events
//------------------------------------------------------------------------------

procedure TfrmFTS.Form_Create(Sender: TObject);
begin
  Caption := APP_TITLE;

  Constraints.MinHeight := Height;
  Constraints.MinWidth := Width;

  edtIndexPath.Text := ExpandFileName('..');

  with cbxExtensions, Items do
    begin
      Add('*.pas');
      Add('*.htm');
      Add('*.txt');
      ItemIndex := 0;
    end;

  with cbxModules, Items do
    begin
      {$IFDEF SQLITE_ENABLE_FTS1}Add('FTS1'); {$ENDIF}
      {$IFDEF SQLITE_ENABLE_FTS2}Add('FTS2'); {$ENDIF}
      {$IFDEF SQLITE_ENABLE_FTS3}Add('FTS3'); {$ENDIF}
    end;

  with cbxTokenizers, Items do
    begin
      Add('simple');
      Add('porter');
      Add('pascal');
    end;

  cbxWordWrap.Checked := memoContents.WordWrap;

  {$IFDEF COMPILER_7_UP}
  { Starting with Delphi 7, a new TPanel.ParentBackground property defaults
    to True which suppresses our custom color settings. }
  pnlIndexCaption.ParentBackground := False;
  pnlSearchCaption.ParentBackground := False;
  {$ENDIF COMPLIER_7_UP}

  CreateDatabase;

  {$IFDEF SQLITE_ENABLE_FTS3}
  cbxModules.ItemIndex := 2;
  cbxTokenizers.ItemIndex := 2;
  {$ELSE SQLITE_ENABLE_FTS3}
  {$IFDEF SQLITE_ENABLE_FTS2}
  cbxModules.ItemIndex := 1;
  cbxTokenizers.ItemIndex := 2;
  {$ELSE SQLITE_ENABLE_FTS2}
  cbxModules.ItemIndex := 0;
  cbxTokenizers.ItemIndex := 0;
  {$ENDIF SQLITE_ENABLE_FTS2}
  {$ENDIF SQLITE_ENABLE_FTS3}
end;

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

procedure TfrmFTS.Form_Destroy(Sender: TObject);
begin
  CloseDatabase;
end;

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

procedure TfrmFTS.btnIndexPathSelect_Click(Sender: TObject);
var
  s: string;
begin
  s := edtIndexPath.Text;
  if Selectdirectory('Select Directory', '', s) then
    edtIndexPath.Text := s;
end;

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

procedure TfrmFTS.btnAddToIndex_Click(Sender: TObject);
begin
  AddFiles(edtIndexPath.Text, cbxRecurse.Checked, cbxTokenizers.Text);
end;

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

procedure TfrmFTS.btnClearIndex_Click(Sender: TObject);
begin
  ClearIndex;
end;

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

procedure TfrmFTS.btnSearch_Click(Sender: TObject);
begin
  SearchFiles(edtSearch.Text);
end;

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

procedure TfrmFTS.edtSearch_KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  case Key of
    VK_RETURN:
      SearchFiles(edtSearch.Text);
    VK_PRIOR, VK_NEXT, VK_UP, VK_DOWN:
      begin
        SendMessage(lbxResults.Handle, WM_KEYDOWN, Key, 0);
        Key := 0;
      end;
    Ord('A'):
      if ssCtrl in Shift then
        edtSearch.SelectAll;
  end;
end;

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

procedure TfrmFTS.lbxResults_Click(Sender: TObject);
var
  i: Integer;
begin
  i := lbxResults.ItemIndex;
  if i >= 0 then
    ShowContents(Integer(lbxResults.Items.Objects[i]));
end;

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

procedure TfrmFTS.lbxResults_DblClick(Sender: TObject);
var
  p: TPoint;
  i: Integer;
begin
  if GetCursorPos(p) then
    with (Sender as TListBox) do
      begin
        i := itematpos(ScreenToClient(p), True);
        if i >= 0 then
          ShellExecute(GetDeskTopWindow, 'open', PChar(Items[i]), nil, nil, SW_SHOWNORMAL);
      end;
end;

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

procedure TfrmFTS.cbxWordWrap_Click(Sender: TObject);
var
  b: Boolean;
begin
  b := cbxWordWrap.Checked;
  with memoContents do
    begin
      WordWrap := b;
      if b then
        ScrollBars := ssVertical
      else
        ScrollBars := ssBoth;
    end;
end;

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

procedure TfrmFTS.btnNext_Click(Sender: TObject);
begin
  HighlightNext;
end;

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

procedure TfrmFTS.btnPrevious_Click(Sender: TObject);
begin
  HighlightPrevious;
end;

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

procedure TfrmFTS.btnFirst_Click(Sender: TObject);
begin
  HighlightFirst;
end;

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

procedure TfrmFTS.btnLast_Click(Sender: TObject);
begin
  HighlightLast;
end;

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

procedure TfrmFTS.memoContents_KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if (ssCtrl in Shift) and (Key = Ord('A')) then
    memoContents.SelectAll;
end;

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

initialization
  { Initialize the DISQLite3 library prior to using any other DISQLite3
    functionality. See also sqlite3_shutdown() below.}
  sqlite3_initialize;

finalization
  { Deallocate any resources that were allocated by
  sqlite3_initialize() above. }
  sqlite3_shutdown;

end.

