{ 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

  Copyright (c) 2005-2021 Ralf Junker, Yunqa <delphi@yunqa.de>

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

unit DISQLite3_Full_Text_Search_Form_Main;

{$I DICompilers.inc}
{$I DISQLite3.inc}

{$DEFINE DI_Debug} // Default: Off.

{$IFNDEF YuStemmer}
{$IFDEF COMPILER_6_UP}
{$MESSAGE 'For multi-language stemming support, $DEFINE the YuStemmer directive and rebuild.'}
{$MESSAGE 'YuStemmer is available from http://www.yunqa.de.'}
{$ENDIF COMPILER_6_UP}
{$ENDIF YuStemmer}

{ MatchInfo requires DISQLite3 Pro. It is supported by FTS3 and FTS4.
  Define the SUPPORTS_MATCHINFO compiler directive if we have either. }
{$UNDEF SUPPORTS_MATCHINFO}
{$IFNDEF DISQLite3_Personal}
{$IFDEF SQLITE_ENABLE_FTS3}{$DEFINE SUPPORTS_MATCHINFO}{$ENDIF}
{$IFDEF SQLITE_ENABLE_FTS4}{$DEFINE SUPPORTS_MATCHINFO}{$ENDIF}
{$ENDIF !DISQLite3_Personal}

{ FTS4 compression requires DISQLite3 Pro.
  It also needs zlib, available with Delphi 5 only. }
{$UNDEF SUPPORTS_COMPRESSION}
{$IFNDEF DISQLite3_Personal}{$IFDEF COMPILER_5_UP}
{$DEFINE SUPPORTS_COMPRESSION}
{$ENDIF COMPILER_5_UP}{$ENDIF !DISQLite3_Personal}

{ Suppress deprecated warnings. }
{$IFDEF SUPPORTS_DEPRECATED}{$WARN SYMBOL_DEPRECATED OFF}{$ENDIF}

interface

uses
  {$IFDEF HAS_UNITSCOPE}
  System.UITypes, System.Classes, Winapi.Windows, Vcl.Controls, Vcl.Menus,
  Vcl.Forms, Vcl.StdCtrls, Vcl.ComCtrls, Vcl.ExtCtrls,
  {$ELSE HAS_UNITSCOPE}
  Classes, Windows, Controls, Menus, Forms, StdCtrls, ComCtrls, ExtCtrls,
  {$ENDIF HAS_UNITSCOPE}
  DISystemCompat, DISQLite3Database;

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

  TfrmFTS = class(TForm)
    pnlIndex: TPanel;
    edtIndexPath: TEdit;
    btnAddToIndex: TButton;
    lblFolder: TLabel;
    btnIndexPathSelect: TButton;
    cbxRecurse: TCheckBox;
    pnlSearch: TPanel;
    lblSearchExpression: TLabel;
    edtSearch: TEdit;
    btnSearch: TButton;
    pnlIndexCaption: TPanel;
    pnlSearchCaption: TPanel;
    pnlResults: TPanel;
    memoContents: TMemo;
    StatusBar: TStatusBar;
    Splitter1: TSplitter;
    cbxModules: TComboBox;
    lblModule: TLabel;
    cbxFilePatterns: TComboBox;
    pnlSearchResult: TPanel;
    cbxWordWrap: TCheckBox;
    btnNext: TButton;
    btnPrevious: TButton;
    btnFirst: TButton;
    btnLast: TButton;
    cbxTokenizers: TComboBox;
    lblTokenizer: TLabel;
    btnClearIndex: TButton;
    lblStemmer: TLabel;
    cbxStemmers: TComboBox;
    lblFilePatterns: TLabel;
    lvResults: TListView;
    cbxCompress: TCheckBox;
    mnuResultsPopup: TPopupMenu;
    mnuCopyPathFileName: TMenuItem;
    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 lvResults_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);
    procedure lvResults_Change(Sender: TObject; Item: TListItem; Change: TItemChange);
    procedure cbxModules_Change(Sender: TObject);
    procedure lvResults_ColumnClick(Sender: TObject; Column: TListColumn);
    procedure lvResults_Compare(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer);
    procedure mnuCopyPathFileName_Click(Sender: TObject);
    procedure lvResults_ContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean);
  private
    FDb: TDISQLite3Database;
    FCurrentContentID: Int64;
    FCurrentOffsets: TOffsetInfoArray;
    FCurrentOffsetIdx: Integer;
    FCurrentSearch: UnicodeString;
    FResultsSortColumn: Integer;
    FResultsSortDesc: Boolean;
    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 ATokenizerName: string;
      const ATokenizerArgs: 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: UnicodeString);
    procedure ShowContents(const FileID: Integer);
  end;

var
  frmFTS: TfrmFTS;

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

implementation

uses
  {$IFDEF HAS_UNITSCOPE}
  Winapi.Messages, Winapi.ShellAPI, System.SysUtils, Vcl.Dialogs, Vcl.FileCtrl,
  System.IniFiles, Vcl.Clipbrd,
  {$ELSE HAS_UNITSCOPE}
  Messages, ShellAPI, SysUtils, Dialogs, FileCtrl, IniFiles, Clipbrd,
  {$ENDIF HAS_UNITSCOPE}
  DIUtils, DISQLite3Api, DISQLite3Tokenizer
  {$IFNDEF DISQLite3_Personal}, DISQLite3Collations{$ENDIF}
  {$IFDEF SUPPORTS_COMPRESSION}, DISQLite3ZLib{$ENDIF}
  {$IFDEF YuStemmer}, YuStemmer{$ENDIF}; // Download from http://www.yunqa.de.

{$R *.dfm}

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

  {$IFDEF SUPPORTS_MATCHINFO}
  { SQLite user defined function to use with matchinfo() to calculate the
    relevancy of an FTS4 match. The value returned is the relevancy score
    (a real value greater than or equal to zero). A larger value indicates
    a more relevant document.

    The overall relevancy returned is the sum of the relevancies of each
    column value in the FTS table. The relevancy of a column value is the
    sum of the following for each reportable phrase in the FTS query:

      (<hit count> / <global hit count>) * <column weight>

    where <hit count> is the number of instances of the phrase in the
    column value of the current row and <global hit count> is the number
    of instances of the phrase in the same column of all rows in the FTS
    table. The <column weight> is a weighting factor assigned to each
    column by the caller (see below).

    The first argument to this function must be the return value of the FTS
    matchinfo() function. Following this must be one argument for each column
    of the FTS table containing a numeric weight factor for the corresponding
    column. Example:

      CREATE VIRTUAL TABLE documents USING fts3(title, content)

    The following query returns the docids of documents that match the full-text
    query <query> sorted from most to least relevant. When calculating
    relevance, query term instances in the 'title' column are given twice the
    weighting of those in the 'content' column.

      SELECT docid FROM documents
      WHERE documents MATCH <query>
      ORDER BY rank(matchinfo(documents), 1.0, 0.5) DESC }
procedure rank_func(
  pCtx: sqlite3_context_ptr;
  nVal: Integer;
  apVal: sqlite3_value_ptr_array_ptr); {$IFDEF DISQLite3_CDECL} cdecl; {$ENDIF}
label
  wrong_number_args;
var
  aMatchinfo: PIntegerArray; { Return value of matchinfo() }
  aPhraseinfo: PIntegerArray;
  iCol: Integer; { Current column }
  iPhrase: Integer; { Current phrase }
  nCol: Integer; { Number of columns in the table }
  nGlobalHitCount: Integer;
  nHitCount: Integer;
  nPhrase: Integer; { Number of phrases in the query }
  score: Double; { Value to return }
  Weight: Double;
begin
  Assert(SizeOf(Integer) = 4);

  { Check that the number of arguments passed to this function is correct.
    If not, jump to wrong_number_args. Set aMatchinfo to point to the array
    of unsigned integer values returned by FTS function matchinfo. Set
    nPhrase to contain the number of reportable phrases in the users full-text
    query, and nCol to the number of columns in the table. }
  if nVal < 1 then
    goto wrong_number_args;
  aMatchinfo := sqlite3_value_blob(apVal[0]);
  nPhrase := aMatchinfo^[0];
  nCol := aMatchinfo^[1];
  if nVal <> 1 + nCol then
    goto wrong_number_args;

  score := 0;

  { Iterate through each phrase in the users query. }
  for iPhrase := 0 to nPhrase - 1 do
    begin
      { Now iterate through each column in the users query. For each column,
        increment the relevancy score by:

          ( <hit count> / <global hit count> ) * <column weight>

        aPhraseinfo[] points to the start of the data for phrase iPhrase. So
        the hit count and global hit counts for each column are found in
        aPhraseinfoiCol*3 and aPhraseinfoiCol*3+1, respectively. }
      aPhraseinfo := Pointer(@aMatchinfo[2 + iPhrase * nCol * 3]);
      for iCol := 0 to nCol - 1 do
        begin
          nHitCount := aPhraseinfo^[3 * iCol];
          nGlobalHitCount := aPhraseinfo[3 * iCol + 1];
          Weight := sqlite3_value_double(apVal[iCol + 1]);
          if nHitCount > 0 then
            begin
              score := score + nHitCount / nGlobalHitCount * Weight;
            end;
        end;
    end;
  sqlite3_result_double(pCtx, score);
  Exit;

  { Jump here if the wrong number of arguments are passed to this function }
  wrong_number_args:
  sqlite3_result_error(pCtx, 'Wrong number of arguments to function rank()', -1);
end;

{ Calculate the total number of all hits in a FTS result record. }
procedure hits_func(
  pCtx: sqlite3_context_ptr;
  nVal: Integer;
  apVal: sqlite3_value_ptr_array_ptr); {$IFDEF DISQLite3_CDECL} cdecl; {$ENDIF}
label
  wrong_number_args;
var
  aMatchinfo: PIntegerArray; { Return value of matchinfo() }
  aPhraseinfo: PIntegerArray;
  iCol: Integer; { Current column }
  iPhrase: Integer; { Current phrase }
  nCol: Integer; { Number of columns in the table }
  nPhrase: Integer; { Number of phrases in the query }
  hits: Cardinal;
begin
  Assert(SizeOf(Integer) = 4);

  { Check that the number of arguments passed to this function is correct.
    If not, jump to wrong_number_args. }
  if nVal <> 2 then
    goto wrong_number_args;
  { Set aMatchinfo to point to the array of unsigned integer values returned
    by FTS function matchinfo. }
  aMatchinfo := sqlite3_value_blob(apVal[0]);
  { Set nPhrase to contain the number of reportable phrases in the users
    full-text query, and nCol to the number of columns in the table. }
  nPhrase := aMatchinfo^[0];
  nCol := aMatchinfo^[1];

  hits := 0;

  { Iterate through each phrase in the users query. }
  for iPhrase := 0 to nPhrase - 1 do
    begin
      aPhraseinfo := Pointer(@aMatchinfo[2 + iPhrase * nCol * 3]);
      for iCol := 0 to nCol - 1 do
        Inc(hits, aPhraseinfo^[3 * iCol]);
    end;
  sqlite3_result_int(pCtx, hits);
  Exit;

  { Jump here if the wrong number of arguments are passed to this function }
  wrong_number_args:
  sqlite3_result_error(pCtx, 'Wrong number of arguments to function hits()', -1);
end;

{$ENDIF SUPPORTS_MATCHINFO}

//------------------------------------------------------------------------------
// 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
    on e: ESQLite3 do
      if e.ErrorCode = SQLITE_CANTOPEN then
        FDb.CreateDatabase
      else
        raise
    else
      raise;
  end;

  {$IFNDEF DISQLite3_Personal}
  sqlite3_check(sqlite3_create_collation(FDb.Handle, 'USERNOCASE', SQLITE_UTF16, nil, SQLite3_Compare_User_NoCase_UTF16LE), FDb.Handle);
  {$ENDIF ~DISQLite3_Personal}

  { 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', sqlite3Fts3PascalTokenizerModule));
  sqlite3_check(sqlite3Fts2RegisterTokenizer(FDb.Handle, 'unicode', sqlite3Fts3UnicodeTokenizerModule));
  {$ENDIF SQLITE_ENABLE_FTS2}

  {$IFDEF SQLITE_ENABLE_FTS3}
  { This is for both FTS3 and FTS4. }
  {$IFNDEF DISQLite3_DLL}
  sqlite3_check(sqlite3Fts3Init(FDb.Handle), FDb.Handle);
  {$ENDIF !DISQLite3_DLL}
  sqlite3_check(sqlite3Fts3RegisterTokenizer(FDb.Handle, 'pascal', sqlite3Fts3PascalTokenizerModule));
  sqlite3_check(sqlite3Fts3RegisterTokenizer(FDb.Handle, 'unicode', sqlite3Fts3UnicodeTokenizerModule));
  {$IFDEF SUPPORTS_COMPRESSION}
  sqlite3_create_function_zlib(FDb.Handle); // Register zlib compression functions.
  {$ENDIF SUPPORTS_COMPRESSION}
  {$ENDIF SQLITE_ENABLE_FTS3}

  {$IFDEF SUPPORTS_MATCHINFO}
  { Register the "hits" and "rank" callback function used to sort the query
    results.  Available for DISQLite3 Pro only. }
  sqlite3_check(sqlite3_create_function(FDb.Handle, 'hits', -1,
    SQLITE_DETERMINISTIC, nil, hits_func, nil, nil));
  sqlite3_check(sqlite3_create_function(FDb.Handle, 'rank', -1,
    SQLITE_DETERMINISTIC, nil, rank_func, nil, nil));
  {$ENDIF SUPPORTS_MATCHINFO}
end;

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

procedure TfrmFTS.CloseDatabase;
begin
  FreeAndNil(FDb);
end;

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

procedure TfrmFTS.AddFiles(
  aDir: string;
  const ARecurse: Boolean;
  const ATokenizerName: string;
  const ATokenizerArgs: string);

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

var
  StmtFile_Query, StmtFile_Insert, StmtFile_Update,
    StmtContent_Insert: TDISQLite3Statement;
  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 Folder, Extensions: string);
  var
    e: TStringList;

    procedure RecursiveAdd(const Folder: string);
    var
      FN: string;
      i: Integer;
      RowID: Int64;
      s: RawByteString;
      SR: TSearchRec;
    begin
      if FindFirst(Folder + '*', faAnyFile, SR) = 0 then
        try
          repeat
            if (SR.Attr and faDirectory) = 0 then // A file, not a directory.
              for i := 0 to e.Count - 1 do
                begin
                  if StrMatchWildI(SR.Name, e[i]) then
                    begin
                      FN := Folder + SR.Name;
                      if LoadStrAFromFile(FN, s) then
                        begin
                          Inc(TotalFiles); Inc(TotalSize, Length(s));
                          SetStatus(
                            IntToStr(TotalFiles) + ' Files',
                            KiloByteText(TotalSize),
                            KiloByteText(TotalSize * 1000 div GetTickCountDiff) + ' / sec',
                            FN);

                          { Is the file already in the database? }
                          StmtFile_Query.Bind_Str16(1, FN);
                          if StmtFile_Query.Step = SQLITE_ROW then
                            begin
                              { Yes, file is in database. Get its RowID. }
                              RowID := StmtFile_Query.Column_Int64(0);
                            end
                          else
                            begin
                              { No, file is not in database. Add it now. }
                              StmtFile_Insert.Bind_Str16(1, FN);
                              StmtFile_Insert.StepAndReset;
                              RowID := FDb.LastInsertRowID;
                            end;
                          StmtFile_Query.Reset;

                          { Insert or replace file contents. }
                          StmtContent_Insert.Bind_Int64(1, RowID);
                          StmtContent_Insert.Bind_Str16(2, UnicodeString(s));
                          StmtContent_Insert.StepAndReset;
                        end;
                      Break;
                    end;
                end
            else
              if ARecurse and (SR.Name <> '.') and (SR.Name <> '..') then
                RecursiveAdd(Folder + SR.Name + '\');
          until FindNext(SR) <> 0;
        finally
          FindClose(SR);
        end;
    end;

  var
    i: NativeInt;
    s: string;
  begin
    TC := GetTickCount;
    e := TStringList.Create;
    try
      i := 1;
      repeat
        s := StrTrim(ExtractNextWord(Extensions, AC_SEMICOLON, i));
        if i < 0 then Break;
        if s <> '' then
          e.Add(s);
      until i <= 0;

      RecursiveAdd(Folder);
    finally
      e.Free;
    end;
  end;

var
  b: Boolean;
  FTS_Module: string;
  Tokenizer: string;
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 ...');

          FTS_Module := cbxModules.Text;
          Tokenizer := '';

          if FTS_Module >= 'FTS3' then
            begin
              if ATokenizerName <> '' then // Use a tokenizer?
                begin
                  Tokenizer := Tokenizer + ',tokenize=' + ATokenizerName;
                  if ATokenizerArgs <> '' then
                    Tokenizer := Tokenizer + ' ' + ATokenizerArgs;
                end;
            end;

          if FTS_Module >= 'FTS4' then
            begin
              if cbxCompress.Enabled and cbxCompress.Checked then // Compress text contents?
                begin
                  Tokenizer := Tokenizer + ',compress=compress,uncompress=uncompress';
                end;
            end;

          { Create FTS tables:
              * FTS:       stores the file's contents and word index
              * FTS_Files: stores the names of the files indexed }
          FDb.Execute16(
            'CREATE VIRTUAL TABLE ' + FTS_TABLE + '' +
            ' USING ' + FTS_Module + '(Content' + Tokenizer + ')');
          FDb.Execute16(
            'CREATE TABLE ' + FTS_TABLE + '_Files (' +
            ' FileID INTEGER PRIMARY KEY,' +
            ' FileName TEXT UNIQUE COLLATE ' +
            {$IFDEF DISQLite3_Personal} 'nocase'{$ELSE} 'USERNOCASE'{$ENDIF} + ')');
        end;

      FDb.StartTransaction; // For speed!
      try
        { Prepare insertion statements for fastest indexing performance. }
        StmtFile_Query := FDb.Prepare16('SELECT RowID FROM ' + FTS_TABLE + '_Files WHERE FileName=?');
        StmtFile_Insert := FDb.Prepare16('INSERT INTO ' + FTS_TABLE + '_Files (FileName) VALUES (?)');
        StmtFile_Update := FDb.Prepare16('UPDATE ' + FTS_TABLE + '_Files SET FileName=?');

        StmtContent_Insert := FDb.Prepare16('INSERT OR REPLACE INTO ' + FTS_TABLE + ' (RowID, Content) VALUES (?, ?)');
        try
          aDir := ExpandFileName(aDir);
          IncludeTrailingPathDelimiterByRef(aDir);

          TotalFiles := 0; TotalSize := 0;
          { Now scan the directory and add files (recursively). }
          InternalAdd(aDir, cbxFilePatterns.Text);
        finally
          StmtContent_Insert.Free;

          StmtFile_Update.Free;
          StmtFile_Insert.Free;
          StmtFile_Query.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_FTS3}
    FDb.Execute16('DROP TABLE IF EXISTS ' + FTS_TABLE + '_content');
    FDb.Execute16('DROP TABLE IF EXISTS ' + FTS_TABLE + '_docsize');
    FDb.Execute16('DROP TABLE IF EXISTS ' + FTS_TABLE + '_segdir');
    FDb.Execute16('DROP TABLE IF EXISTS ' + FTS_TABLE + '_segments');
    FDb.Execute16('DROP TABLE IF EXISTS ' + FTS_TABLE + '_stat');
    {$ENDIF SQLITE_ENABLE_FTS3}

    {$IFDEF SQLITE_ENABLE_FTS2}
    FDb.Execute16('DROP TABLE IF EXISTS ' + FTS_TABLE + '_content');
    FDb.Execute16('DROP TABLE IF EXISTS ' + FTS_TABLE + '_segdir');
    FDb.Execute16('DROP TABLE IF EXISTS ' + FTS_TABLE + '_segments');
    {$ENDIF SQLITE_ENABLE_FTS2}

    {$IFDEF SQLITE_ENABLE_FTS1}
    FDb.Execute16('DROP TABLE IF EXISTS ' + FTS_TABLE + '_content');
    FDb.Execute16('DROP TABLE IF EXISTS ' + FTS_TABLE + '_term');
    {$ENDIF SQLITE_ENABLE_FTS1}

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

    SetStatus;

    {$IFNDEF SQLITE_OMIT_PAGER_PRAGMAS}
  finally
    { After deleting, 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: UnicodeString);

{ Can we use MatchInfo? It needs FTS3 or FTS4 tables. }
  function MatchInfoSupport: Boolean;
  var
    Stmt: TDISQLite3Statement;
  begin
    Stmt := FDb.Prepare16(
      'SELECT * FROM sqlite_master' +
      ' WHERE type=''table'' AND name=''' + FTS_TABLE + ''' AND' +
      ' (sql GLOB ''*USING FTS3*'' OR sql GLOB ''*USING FTS4*'')');
    try
      Result := Stmt.Step = SQLITE_ROW;
    finally
      Stmt.Free;
    end;
  end;

var
  MIS: Boolean;
  NewItem: TListItem;
  Stmt: TDISQLite3Statement;
  SQL: UnicodeString;
  TC: Cardinal;
begin
  EnableControls(False);
  try
    FCurrentSearch := ASearch;
    ClearResults;

    TC := GetTickCount;

    {$IFDEF SUPPORTS_MATCHINFO}
    MIS := MatchInfoSupport();
    if MIS then
      { This is the ranking query SQL. It needs FTS3 or FTS4 tables and uses the
        rankfunc() callback function defined above to sort the results based on
        the matchinfo() data. Read the FTS3 documentation in the DISQLite3 help
        for details. }
      SQL :=
        'SELECT FileName, FileID, Rank, Hits FROM ' + FTS_TABLE + '_Files JOIN (' +
        '  SELECT' +
        '      RowID as FileID,' +
        '      rank(matchinfo(' + FTS_TABLE + '), 1) AS Rank,' +
        '      hits(matchinfo(' + FTS_TABLE + '), 1) AS Hits' +
        '    FROM ' + FTS_TABLE +
        '    WHERE ' + FTS_TABLE + ' MATCH ?' +
        '    ORDER BY Rank DESC' +
        '  ) AS ranktable USING(FileID)' +
        ' ORDER BY ranktable.rank DESC'
    else
      {$ENDIF SUPPORTS_MATCHINFO}
      begin
        MIS := False;
        { This is the non-ranking query SQL. It works well with all FTS versions. }
        SQL :=
          'SELECT FileName, FileID FROM ' + FTS_TABLE + ', ' + FTS_TABLE + '_Files ' +
          'WHERE ' + FTS_TABLE + '.RowID = ' + FTS_TABLE + '_Files.FileID AND ' +
          FTS_TABLE + ' MATCH ?';
      end;

    try
      { Prepare the full text search statement. It returns the FileName and the FileID. }
      Stmt := FDb.Prepare16(SQL);
    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
      lvResults.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. }
          NewItem := lvResults.Items.Add;
          if MIS then
            begin
              NewItem.Caption := IntToStr(System.Trunc(Stmt.Column_Double(2) * 10000)); // Rank
              NewItem.SubItems.Add(Stmt.Column_Str16(3)); // Hits
            end
          else
            begin
              NewItem.Caption := 'n/a'; // Rank
              NewItem.SubItems.Add('n/a'); // Hits
            end;
          NewItem.SubItems.Add(Stmt.Column_Str16(0)); // FileName
          NewItem.Data := Pointer(Stmt.Column_Int(1)); // FileID
        end;

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

    SetStatus(
      IntToStr(lvResults.Items.Count) + ' found',
      IntToStr(GetTickCount - TC) + ' ms',
      '', '');

    if lvResults.Items.Count > 0 then
      with lvResults.Items[0] do
        begin
          Focused := True;
          Selected := True;
        end;
  finally
    EnableControls(True);
  end;
end;

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

{ Converts an Offset string to an array of TOffsetInfo. Takes care to convert
  UTF-8 byte positions to WideString / UnicodeString 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
          { CR / LF -> CRLF conversion. }
          $0A:
            begin Dec(MatchDelta); Inc(CharOffset); end;
          $0D:
            if (ContentLen > 1) and (ContentPtr[1] = #$0A) then
              begin
                Dec(MatchDelta, 2); Inc(CharOffset);
                Inc(ContentPtr); Dec(ContentLen);
              end
            else
              begin Dec(MatchDelta); Inc(CharOffset); end;
          { UTF-8 expansion. }
          $00..$09, $0B..$0C, $0E..$7F:
            Dec(MatchDelta);
          $80..$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
          { CR / LF -> CRLF conversion. }
          $0A:
            begin Dec(MatchLength); Inc(CharLength); end;
          $0D:
            if (ContentLen > 1) and (ContentPtr[1] = #$0A) then
              begin
                Dec(MatchLength, 2); Inc(CharLength);
                Inc(ContentPtr); Dec(ContentLen);
              end
            else
              begin Dec(MatchLength); Inc(CharLength); end;
          { UTF-8 expansion. }
          $00..$09, $0B..$0C, $0E..$7F:
            Dec(MatchLength);
          $80..$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: UnicodeString;
  Stmt: TDISQLite3Statement;
begin
  if not Assigned(FDb) then Exit;

  EnableControls(False);
  try
    FCurrentContentID := FileID;

    { In the SQL below, the '+' sign in front of the 'rowid' stops the query
      optimizer from being overly aggressive. Starting with SQLite 3.6.22, this
      is no longer needed for FTS3, but still required for FTS2 and FTS1.
      Without the '+', the latter both fail with an "SQL logic error or missing
      database" error. }
    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);
          { Load match offsets into array. }
          FCurrentOffsets := DecodeOffsets(Stmt.Column_Str(1), Content);
          { Call TMemo.Clear first to avoid time consuming comparison of old
            and new text when writing to TMemo.Text. }
          memoContents.Clear; memoContents.Text := AdjustLineBreaksW(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
  FResultsSortColumn := -1;
  FResultsSortDesc := False;
  lvResults.Items.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);
const
  SQLITE_ENABLE_FTS3_PARENTHESIS = 'SQLITE_ENABLE_FTS3_PARENTHESIS';
var
  dim: string;
  {$IFDEF YuStemmer}i: Integer; {$ENDIF }
begin
  if sqlite3_compileoption_used(SQLITE_ENABLE_FTS3_PARENTHESIS) <> 0 then
    Caption := APP_TITLE + ' (' + SQLITE_ENABLE_FTS3_PARENTHESIS + ')'
  else
    Caption := APP_TITLE;

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

  { Read form position. }

  with TIniFile.Create(ChangeFileExt(ParamStr(0), '.ini')) do
    try
      dim := IntToStr(Screen.Width) + 'x' + IntToStr(Screen.Height);
      SetBounds(
        ReadInteger(dim, 'Left', Left),
        ReadInteger(dim, 'Top', Top),
        ReadInteger(dim, 'Width', Width),
        ReadInteger(dim, 'Height', Height));

      lvResults.Height := ReadInteger(dim, 'Results', lvResults.Height);
    finally
      Free;
    end;

  { Initialize controls. }

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

  with cbxFilePatterns, Items do
    begin
      Add('*.pas; *.dpr');
      Add('*.pas; *.dpr; *.pp; *.lpr');
      Add('*.htm; *.html');
      Add('*.txt');
      ItemIndex := 0;
    end;

  with cbxModules, Items do
    begin
      {$IFDEF SQLITE_ENABLE_FTS4}Add('FTS4'); {$ENDIF}
      {$IFDEF SQLITE_ENABLE_FTS3}Add('FTS3'); {$ENDIF}
      {$IFDEF SQLITE_ENABLE_FTS2}Add('FTS2'); {$ENDIF}
      {$IFDEF SQLITE_ENABLE_FTS1}Add('FTS1'); {$ENDIF}
      ItemIndex := 0;
      OnChange(cbxModules); // Update related components.
    end;

  with cbxTokenizers, Items do
    begin
      Add('unicode'); // Delphi implementation in DISQLite3Tokenizer.pas.
      {$IFDEF SQLITE_ENABLE_FTS4_UNICODE61}
      Add('unicode61'); // Part of SQLite's FTS3 since SQLite v. 3.7.13.
      {$ENDIF SQLITE_ENABLE_FTS4_UNICODE61}
      Add('pascal'); // Delphi implementation in DISQLite3Tokenizer.pas.
      Add('porter');
      Add('simple');
    end;

  with cbxStemmers, Items do
    begin
      {$IFDEF YuStemmer}
      Add('');
      for i := Low(STEMMER_LIST_8) to High(STEMMER_LIST_8) do
        Add(Utf8ToString(STEMMER_LIST_8[i]));
      {$ELSE YuStemmer}
      Enabled := False;
      Add('Not compiled in');
      {$ENDIF YuStemmer}
      ItemIndex := 0;
    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}

  {$IFDEF SQLITE_ENABLE_FTS3}
  cbxTokenizers.ItemIndex := 0;
  {$ELSE SQLITE_ENABLE_FTS3}
  {$IFDEF SQLITE_ENABLE_FTS2}
  cbxTokenizers.ItemIndex := 0;
  {$ELSE SQLITE_ENABLE_FTS2}
  cbxTokenizers.ItemIndex := 4;
  {$ENDIF SQLITE_ENABLE_FTS2}
  {$ENDIF SQLITE_ENABLE_FTS3}

  CreateDatabase;
end;

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

procedure TfrmFTS.Form_Destroy(Sender: TObject);
var
  dim: string;
  r: TRect;
  WinPlacement: TWindowPlacement;
begin
  CloseDatabase;

  { Save form position. }

  WinPlacement.Length := SizeOf(WinPlacement);
  GetWindowPlacement(Self.Handle, @WinPlacement);
  r := WinPlacement.rcNormalPosition;

  with TIniFile.Create(ChangeFileExt(ParamStr(0), '.ini')) do
    try
      dim := IntToStr(Screen.Width) + 'x' + IntToStr(Screen.Height);

      WriteInteger(dim, 'Left', r.Left);
      WriteInteger(dim, 'Top', r.Top);
      WriteInteger(dim, 'Width', r.Right - r.Left);
      WriteInteger(dim, 'Height', r.Bottom - r.Top);

      WriteInteger(dim, 'Results', lvResults.Height);
    finally
      Free;
    end;
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.cbxModules_Change(Sender: TObject);
begin
  {$IFDEF SUPPORTS_COMPRESSION}
  cbxCompress.Enabled := cbxModules.Text >= 'FTS4';
  {$ELSE SUPPORTS_COMPRESSION}
  cbxCompress.Enabled := False;
  {$ENDIF SUPPORTS_COMPRESSION}
end;

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

procedure TfrmFTS.btnAddToIndex_Click(Sender: TObject);
begin
  AddFiles(
    edtIndexPath.Text,
    cbxRecurse.Checked,
    cbxTokenizers.Text,
    {$IFDEF YuStemmer}cbxStemmers.Text{$ELSE} ''{$ENDIF});
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(lvResults.Handle, WM_KEYDOWN, Key, 0);
        Key := 0;
      end;
    Ord('A'):
      if ssCtrl in Shift then
        edtSearch.SelectAll;
  end;
end;

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

procedure TfrmFTS.lvResults_Change(Sender: TObject; Item: TListItem; Change: TItemChange);
begin
  case Change of
    ctState:
      if Item.Focused then
        ShowContents(Integer(Item.Data));
  end;
end;

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

procedure TfrmFTS.lvResults_ColumnClick(Sender: TObject; Column: TListColumn);
begin
  if FResultsSortColumn = Column.Index then
    begin
      FResultsSortDesc := not FResultsSortDesc;
    end
  else
    begin
      FResultsSortColumn := Column.Index;
      FResultsSortDesc := False;
    end;
  lvResults.AlphaSort;
end;

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

procedure TfrmFTS.lvResults_Compare(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer);
begin
  if FResultsSortColumn = 0 then
    Compare := StrCompNumI(Item1.Caption, Item2.Caption)
  else
    if FResultsSortColumn > 0 then
      Compare := StrCompNumI(Item1.SubItems[FResultsSortColumn - 1], Item2.SubItems[FResultsSortColumn - 1]);
  if FResultsSortDesc then
    Compare := -Compare;
end;

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

procedure TfrmFTS.lvResults_DblClick(Sender: TObject);
var
  Item: TListItem;
begin
  Item := lvResults.ItemFocused;
  if Assigned(Item) then
    ShellExecute(GetDesktopWindow, 'open', PChar(Item.SubItems[1]), nil, nil, SW_SHOWNORMAL);
end;

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

procedure TfrmFTS.mnuCopyPathFileName_Click(Sender: TObject);
var
  LI: TListItem;
begin
  LI := lvResults.Selected;
  if Assigned(LI) then
    Clipboard.AsText := LI.SubItems[1];
end;

procedure TfrmFTS.lvResults_ContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean);
begin
  mnuCopyPathFileName.Enabled := Assigned(lvResults.Selected);
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.

