1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
|
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, fpTextCat;
Type
{ TProgressLog }
TProgressLog = Class(TObject)
procedure DoLog(Sender : TObject; Const ACurrent,ACount : Integer; Const AURL : String);
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:=@Logger.DoLog;
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: String);
begin
Writeln((ACurrent/ACount*100):5:2,'% : ',ACurrent,'/',ACount,' : ',AURL);
end;
begin
TestIndex(ParamStr(1));
end.
|
