freepascal.compiler/packages/fpindexer/examples/TestIndexer.pp

program TestIndexer;

{ $define usefirebird}
{ $define usemem}
{$mode objfpc}{$H+}
{$IFDEF UNIX}
  {$linklib pthread}
{$ENDIF}

uses
  SysUtils,
  {$IFDEF UNIX} {$IFDEF UseCThreads}
    cthreads,
  {$ENDIF} {$ENDIF}
  {$ifdef usefirebird}
    ibase60dyn,SQLDBIndexDB, fbIndexdb,
  {$else}
    {$ifdef usemem}
      memindexdb,
    {$else}
      SQLIteIndexDB,
    {$endif}
  {$endif}
   fpIndexer,
  //indexer readers
  IReaderTXT, IReaderPAS, IReaderHTML;

Type

  { TProgressLog }

  TProgressLog = Class(TObject)
    procedure DoLog(Sender : TObject; Const ACurrent,ACount : Integer; Const AURL : UTF8String);
  end;

{$ifdef usefirebird}
  function SetupDB : TCustomIndexDB;
  var
    IB: TFBIndexDB;
  begin
    IB := TFBIndexDB.Create(nil);
    try
      IB.DatabasePath := '/home/firebird/index.fb';
      IB.UserName := 'SYSDBA';
      IB.Password := 'masterkey';
      if not FileExists(IB.DatabasePath) then
        IB.CreateDB
      else
      begin
        IB.Connect;
        IB.CreateIndexerTables;
      end;
    except
      FreeAndNil(IB);
      Raise;
    end;
    Result:=IB;
  end;
{$else}
  {$ifdef usemem}
    Function SetupDB : TCustomIndexDB;
    Var
      FI : TFileIndexDB;
    begin
      FI:=TFileIndexDB.Create(Nil);
      FI.FileName:='index.dat';
      FI.Connect;
      FI.WriteOnCommit:=True;;
      Result:=FI;
    end;
  {$else}
    Function SetupDB : TCustomIndexDB;
    Var
      SB: TSQLIteIndexDB;
    begin
      SB := TSQLIteIndexDB.Create(nil);
      SB.FileName := 'index.db';
      if not FileExists(SB.FileName) then
        SB.CreateDB
      else
      begin
        SB.Connect;
        SB.CreateIndexerTables;
      end;
      Result:=SB;
    end;
  {$endif}
{$endif}

Procedure Testindex(ADir : String);
var
  Indexer: TFPIndexer; //indexes files
  start: TDateTime;
  n: int64;
  endtime: TDateTime;
  Logger : TProgressLog;
begin
  //SetHeapTraceOutput('heap.trc');
  start := Now;
  Indexer := TFPIndexer.Create(Nil);
  try
    Indexer.Database:=SetupDB;
    //setup parameters for indexing
    if (ADir<>'') then
      Indexer.SearchPath:=ADir
    else
{$ifdef unix}
      Indexer.SearchPath := '/home/michael/fpc/docs/fcl';
{$else}
      Indexer.SearchPath := 'C:\fcl';
{$endif}
    Indexer.FileMask := '*.pas;*.html;readme.txt'; //semicolon separated list
    Indexer.SearchRecursive := True;
    Indexer.DetectLanguage := False;
    IgnoreListManager.LoadIgnoreWordsFromFile('english','english.txt');
    indexer.Language:='english';
    Indexer.UseIgnoreList:=true;
    Logger := TProgressLog.Create;
    try
      Indexer.OnProgress:[email protected];
      n := Indexer.Execute(True);
    finally
      Logger.Free;
    end;
    //execute the search

    endtime := Now;
    if N <> 0 then
      writeln('indexing succesfull')
    else
      writeln('error indexing.');
    writeln(Format('done in %.1f sec.', [(endtime - start) * 24 * 3600]));
  finally
    Indexer.Database.free;
    FreeAndNil(Indexer);
  end;
end;

{ TProgressLog }

procedure TProgressLog.DoLog(Sender: TObject; const ACurrent, ACount: Integer;
  const AURL: UTF8String);
begin
  Writeln((ACurrent/ACount*100):5:2,'% : ',ACurrent,'/',ACount,' : ',AURL);
end;

begin
  TestIndex(ParamStr(1));
end.