1{
2    This file is part of the Free Component Library (FCL)
3    Copyright (c) 2012 by the Free Pascal development team
4
5    Memory database
6
7    See the file COPYING.FPC, included in this distribution,
8    for details about the copyright.
9
10    This program is distributed in the hope that it will be useful,
11    but WITHOUT ANY WARRANTY; without even the implied warranty of
12    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
13
14 **********************************************************************}
15unit memindexdb;
16
17{$mode objfpc}{$H+}
18
19interface
20
21uses
22  Classes, SysUtils, fpindexer, contnrs;
23
24Type
25  TMatch = Class;
26
27  { TDescrItem }
28
29  TDescrItem = Class(TCollectionItem)
30  private
31    FDescription: UTF8string;
32    FTheID: Integer;
33  Protected
34    Function BlockSize : Integer; virtual;
35    Procedure WriteStringToStream(Astream : TStream; S : UTF8string);
36    Procedure WriteToStream(S : TStream); virtual;
37    Procedure WriteRefToStream(AStream : Tstream; AItem : TDescrItem);
38    Function ReadStringFromStream(Astream : TStream) :  UTF8string;
39    Function ReadFromStream(S : TStream) : Integer; virtual;
40  Published
41    // The description
42    Property Description : UTF8string Read FDescription Write FDescription;
43    // ID. Not used during work. Only used when loading/saving,
44    // it then equals the Index. (index is slow, uses a linear search)
45    Property TheID : Integer Read FTheID Write FTheID;
46  end;
47
48  { TDescrCollection }
49
50  TDescrCollection = Class(TCollection)
51  private
52    FHash : TFPhashList;
53    FLoadCount : Integer;
54    function GetD(AIndex : Integer): TDescrItem;
55    procedure SetD(AIndex : Integer; AValue: TDescrItem);
56  Protected
57    Procedure RebuildHash;
58    Function Resolve(AIndex : Integer) : TDescrItem;
59  Public
60    destructor destroy; override;
61    Procedure BeginLoading;
62    Procedure EndLoading;
63    Procedure AllocateIDS;
64    Function FindDescr(Const ADescription : UTF8string) : TDescrItem;
65    Function AddDescr(Const ADescription : UTF8string) : TDescrItem;
66    Property Descr [AIndex : Integer] : TDescrItem Read GetD Write SetD; default;
67  end;
68
69  TLanguageItem = Class(TDescrItem);
70
71  TMatchedItem = Class(TDescrItem)
72  Private
73    FList : TFPList;
74    function GetMatch(AIndex : Integer): TMatch;
75    function GetMatchCount: Integer;
76  Protected
77    Function AddMatch(AMatch : TMatch) : Integer;
78    Procedure RemoveMatch(AMatch : TMatch);
79  Public
80    Constructor Create(ACollection : TCollection); override;
81    Destructor Destroy; override;
82    Property Matches [AIndex : Integer] : TMatch Read GetMatch; default;
83    Property MatchCount :  Integer Read GetMatchCount;
84  end;
85
86  { TWordItem }
87
88  TWordItem = Class(TMatchedItem)
89  Public
90    Function IsAvailableMatch(aContaining : UTF8string; aPartial : TAvailableMatch) : Boolean;
91  end;
92
93  { TURLItem }
94
95  TURLItem = Class(TMatchedItem)
96  private
97    FLanguage: TLanguageItem;
98    FURLDate: TDateTime;
99    FLangID : Integer;
100  protected
101    Function BlockSize : Integer; override;
102    Procedure WriteToStream(S : TStream); override;
103    Function ReadFromStream(S : TStream) : Integer; override;
104    Procedure Resolve(Languages: TDescrCollection);
105  Public
106    Property URLDate : TDateTime Read FURLDate Write FURLDate;
107    Property Language : TLanguageItem Read FLanguage Write FLanguage;
108  end;
109
110
111
112  { TMatch }
113
114  TMatch = Class(TDescrItem)
115  private
116    FPosition: Int64;
117    FURL: TURLItem;
118    FWord: TWordItem;
119    FWordID : Integer;
120    FURLID : Integer;
121    function GetContext: UTF8string;
122    procedure SetContext(AValue: UTF8string);
123    procedure SetURL(AValue: TURLItem);
124    procedure SetWord(AValue: TWordItem);
125  protected
126    Function BlockSize : Integer; override;
127    Procedure WriteToStream(S : TStream); override;
128    Procedure Resolve(Words, URLS : TDescrCollection);
129    Function ReadFromStream(S : TStream) : Integer; override;
130  Public
131    Property Word : TWordItem Read FWord Write SetWord;
132    Property URL : TURLItem Read FURL Write SetURL;
133    Property Position : Int64 Read FPosition Write FPosition;
134    Property Context : UTF8string Read GetContext Write SetContext;
135  end;
136
137  { TMatches }
138
139  TMatches = Class(TCollection)
140  private
141    function GetM(AIndex : Integer): TMatch;
142    procedure SetM(AIndex : Integer; AValue: TMatch);
143  Public
144    Function AddMatch(AWord : TWordItem; AURL : TURLItem) : TMatch;
145    Property Matches[AIndex : Integer] : TMatch Read GetM Write SetM; default;
146  end;
147
148  { TMemIndexDB }
149
150  TMemIndexDB = class(TCustomIndexDB)
151  Private
152    FStream: TStream;
153    FURLS : TDescrCollection;
154    FLanguages : TDescrCollection;
155    FWords : TDescrCollection;
156    FMatches : TMatches;
157    procedure GetMatches(AWord: UTF8string; SearchOptions: TSearchOptions;  AList: TFPList);
158    procedure IntersectMatches(ListA, ListB: TFPList);
159    procedure UnionMatches(ListA, ListB: TFPList);
160  protected
161    Procedure LoadFromStream; virtual; abstract;
162    Procedure SaveToStream; virtual; abstract;
163    procedure Clear;virtual;
164  public
165    Constructor Create(AOwner : TComponent); override;
166    Destructor Destroy; override;
167    procedure Connect; override;
168    procedure DisConnect; override;
169    procedure CommitTrans; override;
170    procedure BeginTrans; override;
171    procedure CompactDB; override;
172    Procedure CreateDB; override;
173    procedure DeleteWordsFromFile(URL: UTF8string); override;
174    procedure AddSearchData(ASearchData: TSearchWordData); override;
175    procedure FindSearchData(SearchWord: TWordParser; FPSearch: TFPSearch; SearchOptions: TSearchOptions); override;
176    Function GetAvailableWords(out aList : TUTF8StringArray; aContaining : UTF8String; Partial : TAvailableMatch) : integer;override;
177    procedure CreateIndexerTables; override;
178    Property Stream : TStream Read FStream Write FStream;
179  end;
180
181  { TFileIndexDB }
182
183  TFileIndexDB = Class(TMemIndexDB)
184  private
185    FFIleName: UTF8string;
186    FWriteOnCommit: Boolean;
187  Protected
188    Procedure LoadFromStream; override;
189    Procedure SaveToStream; override;
190  Public
191    procedure Connect; override;
192    procedure DisConnect; override;
193    procedure CommitTrans; override;
194    Property FileName : UTF8string Read FFIleName Write FFileName;
195    Property WriteOnCommit : Boolean Read FWriteOnCommit Write FWriteOnCommit;
196  end;
197
198implementation
199
200uses bufstream;
201
202{ TMemIndexDB }
203
204Resourcestring
205  // SErrNoStream = 'No stream assigned';
206  SInvalidStreamData = 'Invalid data at offset %d. Got %d, expected %d.';
207
208{ TFileIndexDB }
209
210Const
211  FileVersion    = 1;
212  LanguageBlock  = 1;
213  URLBlock       = 2;
214  WordBlock      = 3;
215  MatchBlock     = 4;
216
217{ TWordItem }
218
219function TWordItem.IsAvailableMatch(aContaining: UTF8string; aPartial: TAvailableMatch): Boolean;
220begin
221  case aPartial of
222    amAll   : Result:=True;
223    amExact : Result:=(Description=AContaining);
224    amContains : Result:=Pos(aContaining,Description)>0;
225    amStartsWith : Result:=Pos(aContaining,Description)=1;
226  end;
227end;
228
229{ TURLItem }
230
231function TURLItem.BlockSize: Integer;
232begin
233  Result:=inherited BlockSize;
234  Result:=Result+sizeOf(FURLDate)+SizeOf(Integer);
235end;
236
237procedure TURLItem.WriteToStream(S: TStream);
238
239
240begin
241  inherited WriteToStream(S);
242  S.WriteBuffer(FURLDate,SizeOf(FURLDate));
243  WriteRefToStream(S,FLanguage);
244end;
245
246function TURLItem.ReadFromStream(S: TStream): Integer;
247begin
248  Result:=inherited ReadFromStream(S);
249  S.ReadBuffer(FURLDate,SizeOf(FURLDate));
250  S.ReadBuffer(FLangID,SizeOf(FLangID));
251end;
252
253procedure TURLItem.Resolve(Languages: TDescrCollection);
254begin
255  FLanguage:=TLanguageItem(Languages.Resolve(FLangID));
256end;
257
258{ TDescrItem }
259
260function TDescrItem.BlockSize: Integer;
261begin
262  Result:=Sizeof(Integer)+Length(FDescription)*SizeOf(Char);
263end;
264
265procedure TDescrItem.WriteStringToStream(Astream: TStream; S: UTF8string);
266Var
267  L : Integer;
268begin
269  L:=Length(S);
270  AStream.WriteBuffer(L,SizeOf(L));
271  if (L>0) then
272    AStream.WriteBuffer(S[1],L*SizeOf(Char));
273end;
274
275procedure TDescrItem.WriteToStream(S: TStream);
276
277begin
278  S.WriteDWord(BlockSize);
279  WriteStringToStream(S,FDescription);
280end;
281
282procedure TDescrItem.WriteRefToStream(AStream : Tstream; AItem: TDescrItem);
283
284Var
285  I : Integer;
286
287begin
288  If AItem=Nil then
289    I:=0
290  else
291    I:=AItem.TheID;
292  AStream.WriteBuffer(I,SizeOf(I));
293end;
294
295function TDescrItem.ReadStringFromStream(Astream: TStream): UTF8string;
296Var
297  L : Integer;
298begin
299  L:=0;
300  AStream.ReadBuffer(L,SizeOf(L));
301  SetLength(Result,L);
302  if (L>0) then
303    AStream.ReadBuffer(Pointer(Result)^,L*SizeOf(Char));
304end;
305
306function TDescrItem.ReadFromStream(S: TStream) : Integer;
307
308begin
309  Result:=0;
310  S.ReadBuffer(Result,SizeOf(Result));
311  Description:=ReadStringFromStream(S);
312end;
313
314
315procedure TFileIndexDB.LoadFromStream;
316Var
317  I,S,L : Integer;
318  U : TURLItem;
319  W : TWordItem;
320  M : TMatch;
321  Li : TLanguageItem;
322
323begin
324  Clear;
325  L:=Stream.ReadDWord;
326  if (L<>FileVersion) then
327     Raise EFPIndexEr.CreateFmt(SInvalidStreamData,[Stream.Position,L,FileVersion]);
328  L:=Stream.ReadDWord;
329  if (L<>LanguageBlock) then
330    Raise EFPIndexEr.CreateFmt(SInvalidStreamData,[Stream.Position,L,LanguageBlock]);
331  L:=Stream.ReadDWord;
332  FLanguages.BeginLoading;
333  For I:=0 to L-1 do
334    begin
335    Li:=TLanguageItem(FLanguages.Add);
336    S:=Li.ReadFromStream(Stream);
337    if (S<>Li.BlockSize) then
338      Raise EFPIndexEr.CreateFmt(SInvalidStreamData,[Stream.Position,S,Li.BlockSize]);
339    end;
340  FLanguages.EndLoading;
341  L:=Stream.ReadDWord;
342  if (L<>URLBlock) then
343    Raise EFPIndexEr.CreateFmt(SInvalidStreamData,[Stream.Position,L,URLBlock]);
344  L:=Stream.ReadDWord;
345  FURLS.BeginLoading;
346  For I:=0 to L-1 do
347    begin
348    U:=TURLItem(FURLS.AddDescr(''));
349    S:=U.ReadFromStream(Stream);
350    if (S<>U.BlockSize) then
351      Raise EFPIndexEr.CreateFmt(SInvalidStreamData,[Stream.Position,S,U.BlockSize]);
352    U.Resolve(FLanguages);
353    end;
354  FURLS.EndLoading;
355  L:=Stream.ReadDWord;
356  if (L<>WordBlock) then
357    Raise EFPIndexEr.CreateFmt(SInvalidStreamData,[Stream.Position,L,WordBlock]);
358  L:=Stream.ReadDWord;
359  FWords.BeginLoading;
360  For I:=0 to L-1 do
361    begin
362    W:=TWordItem(FWords.AddDescr(''));
363    S:=W.ReadFromStream(Stream);
364    if (S<>W.BlockSize) then
365      Raise EFPIndexEr.CreateFmt(SInvalidStreamData,[Stream.Position,S,W.BlockSize]);
366    end;
367  FWords.EndLoading;
368  L:=Stream.ReadDWord;
369  if (L<>MatchBlock) then
370    Raise EFPIndexEr.CreateFmt(SInvalidStreamData,[Stream.Position,L,MatchBlock]);
371  L:=Stream.ReadDWord;
372  For I:=0 to L-1 do
373    begin
374    M:=TMatch(FMatches.Add);
375    S:=M.ReadFromStream(Stream);
376    M.Resolve(FWords,FURLS);
377    if (S<>M.BlockSize) then
378      Raise EFPIndexEr.CreateFmt(SInvalidStreamData,[Stream.Position,S,M.BlockSize]);
379    end;
380end;
381
382procedure TFileIndexDB.SaveToStream;
383
384Var
385  I : Integer;
386
387begin
388  Stream.WriteDWord(FileVersion);
389  Stream.WriteDWord(LanguageBlock);
390  Stream.WriteDWord(FLanguages.Count);
391  For I:=0 to FLanguages.Count-1 do
392    FLanguages[i].WriteToStream(Stream);
393  Stream.WriteDWord(URLBlock);
394  Stream.WriteDWord(FURLS.Count);
395  For I:=0 to FURLS.Count-1 do
396    FURLS[i].WriteToStream(Stream);
397  Stream.WriteDWord(WordBlock);
398  Stream.WriteDWord(FWords.Count);
399  For I:=0 to FWords.Count-1 do
400    FWords[i].WriteToStream(Stream);
401  Stream.WriteDWord(MatchBlock);
402  Stream.WriteDWord(FMatches.Count);
403  For I:=0 to FMatches.Count-1 do
404    FMatches[i].WriteToStream(Stream);
405end;
406
407procedure TFileIndexDB.Connect;
408
409Var
410  F : TFileStream;
411  B : TReadBufStream;
412
413begin
414  B:=Nil;
415  F:=Nil;
416  if FileExists(FileName) then
417    begin
418    F:=TFileStream.Create(FileName,fmOpenRead);
419    B:=TReadBufStream.Create(F,1000000);
420    B.SourceOwner:=True;
421    end;
422  try
423    Stream:=B;
424    inherited Connect;
425  finally
426    Stream.Free;
427  end;
428end;
429
430procedure TFileIndexDB.DisConnect;
431Var
432  F : TFileStream;
433  B : TWriteBufStream;
434begin
435  F:=TFileStream.Create(FileName,fmCreate);
436  B:=TWriteBufStream.Create(F,1000000);
437  B.SourceOwner:=True;
438  try
439    Stream:=B;
440    inherited DisConnect;
441  finally
442    Stream.Free;
443    Stream:=Nil;
444  end;
445end;
446
447procedure TFileIndexDB.CommitTrans;
448begin
449  If WriteOnCommit and (FileName<>'') then
450    Disconnect;
451end;
452
453procedure TMemIndexDB.CompactDB;
454begin
455  // Do nothing
456end;
457
458procedure TMemIndexDB.CreateDB;
459begin
460  Clear;
461end;
462
463procedure TMemIndexDB.BeginTrans;
464begin
465  // Do nothing
466end;
467
468procedure TMemIndexDB.CommitTrans;
469begin
470  // Do nothing
471end;
472
473procedure TMemIndexDB.Clear;
474begin
475  FMatches.Clear;
476  FWords.Clear;
477  FURLS.Clear;
478  FLanguages.Clear;
479end;
480
481constructor TMemIndexDB.Create(AOwner: TComponent);
482begin
483  inherited Create(AOwner);
484  FURLS:=TDescrCollection.Create(TURLItem);
485  FWords:=TDescrCollection.Create(TWordItem);
486  FLanguages:=TDescrCollection.Create(TLanguageItem);
487  FMatches:=TMatches.Create(TMatch);
488end;
489
490destructor TMemIndexDB.Destroy;
491begin
492  Clear;
493  FreeAndNil(FMatches);
494  FreeAndNil(FWords);
495  FreeAndNil(FURLS);
496  FreeAndNil(FLanguages);
497  inherited Destroy;
498end;
499
500procedure TMemIndexDB.Connect;
501begin
502  if Assigned(Stream) then
503    LoadFromStream;
504end;
505
506procedure TMemIndexDB.DisConnect;
507begin
508  if Assigned(Stream) then
509    begin
510    FLanguages.AllocateIDs;
511    FURLS.AllocateIDs;
512    FWords.AllocateIDs;
513    SaveToStream
514    end;
515end;
516
517procedure TMemIndexDB.DeleteWordsFromFile(URL: UTF8string);
518begin
519 // inherited DeleteWordsFromFile(URL);
520end;
521
522procedure TMemIndexDB.AddSearchData(ASearchData: TSearchWordData);
523
524Var
525  AURL : TURLItem;
526  AWord : TWordItem;
527  M : TMatch;
528  L : TLanguageItem;
529
530begin
531//  Writeln('Adding search data : ',ASearchData.URL,' : ',ASearchData.SearchWord);
532
533  AURL:=TURLItem(FURLs.FindDescr(ASearchData.URL));
534  If (AURL=Nil) then
535    begin
536    L:=TLanguageItem(FLanguages.FindDescr(ASearchData.Language));
537    If (L=Nil) then
538      begin
539//      Writeln('adding language : ',ASearchData.Language);
540      L:=TLanguageItem(FLanguages.AddDescr(ASearchData.Language));
541      end;
542//    Writeln('adding URL : ',ASearchData.URL);
543    AURL:=TURLItem(FURLS.AddDescr(ASearchData.URL));
544    AURL.URLDate:=ASearchData.FileDate;
545    AURL.Language:=L;
546    end;
547  AWord:=TWordItem(FWords.FindDescr(ASearchData.SearchWord));
548  If (AWord=Nil) then
549    begin
550//    Writeln('adding Word : ',ASearchData.SearchWord);
551    AWord:=TWordItem(FWords.AddDescr(ASearchData.SearchWord));
552    end;
553//  Writeln('Adding match : ',ASearchData.Position, ' ',ASearchData.Context);
554  M:=FMatches.AddMatch(AWord,AURL);
555  M.Position:=ASearchData.Position;
556  M.Context:=ASearchData.Context;
557end;
558
559procedure TMemIndexDB.UnionMatches(ListA,ListB : TFPList);
560
561begin
562  ListA.AddList(ListB);
563end;
564
565procedure TMemIndexDB.IntersectMatches(ListA,ListB : TFPList);
566
567Var
568  URL : TURLItem;
569  I,J : Integer;
570
571begin
572  For I:=ListA.Count-1 downto 0 do
573    begin
574    URL:=TMatch(ListA[i]).URL;
575    J:=ListB.Count-1;
576    While (J>=0) and (TMatch(ListB[i]).URL<>URL) do
577      Dec(J);
578    if (J=-1) then
579      ListA.Delete(I);
580    end;
581end;
582
583procedure TMemIndexDB.GetMatches(AWord : UTF8string; SearchOptions: TSearchOptions; AList : TFPList);
584
585  Procedure AddMatches(W : TWordItem);
586  Var
587    I : Integer;
588
589  begin
590    For I:=0 to W.MatchCount-1 do
591      AList.Add(W.Matches[i]);
592  end;
593
594Var
595  W : TWordItem;
596  I : Integer;
597
598begin
599  If (AWord='') then exit;
600  if (AWord[1]='''') then
601    Delete(AWord,1,1);
602  I:=Length(AWord);
603  if (AWord[i]='''') then
604    Delete(AWord,i,1);
605  AWord:=LowerCase(AWord);
606  if soContains in SearchOptions then
607    begin
608    For I:=0 to FWords.Count-1 do
609      begin
610      W:=TWordItem(FWords[i]);
611      If Pos(Aword,W.Description)<>0 then
612        AddMatches(W);
613      end
614    end
615  else
616    begin
617    W:=TWordItem(FWords.FindDescr(AWord));
618    if (W<>Nil) then
619      AddMatches(W);
620    end;
621end;
622
623procedure TMemIndexDB.FindSearchData(SearchWord: TWordParser;
624  FPSearch: TFPSearch; SearchOptions: TSearchOptions);
625
626Var
627  L,W : TFPList;
628  S : UTF8string;
629  I : Integer;
630  M : TMatch;
631  WD : TSearchWordData;
632
633begin
634  L:=TFPList.Create;
635  try
636    W:=TFPList.Create;
637    for I:=0 to SearchWord.Count-1 do
638      begin
639      Case SearchWord.Token[i].TokenType of
640        wtWord : begin
641                 S:=LowerCase(SearchWord.Token[i].Value);
642                 if (I=0) then
643                   GetMatches(S,SearchOptions,L)
644                 else
645                   GetMatches(S,SearchOptions,W);
646                 end;
647        wtOr :
648          UnionMatches(L,W);
649        wtAnd :
650          InterSectMatches(L,W);
651      end;
652      end;
653    For I:=0 to L.Count-1 do
654      begin
655      M:=TMatch(L[i]);
656      WD.SearchWord:=M.Word.Description;
657      WD.Context:=M.Context;
658      WD.FileDate:=M.URL.URLDate;
659      WD.URL:=M.URL.Description;
660      WD.Position:=M.Position;
661      WD.Language:=M.URL.Language.Description;
662      FPSearch.AddResult(i,WD);
663      end;
664  finally
665    L.Free;
666  end;
667end;
668
669function TMemIndexDB.GetAvailableWords(out aList: TUTF8StringArray; aContaining: UTF8String; Partial: TAvailableMatch): integer;
670
671Var
672  I : integer;
673
674begin
675  Result:=0;
676  aContaining:=LowerCase(aContaining);
677  SetLength(aList,FWords.Count);
678  For I:=0 to FWords.Count-1 do
679    if TWordItem(FWords[i]).IsAvailableMatch(aContaining,Partial) then
680      begin
681      aList[Result]:=FWords[i].Description;
682      Inc(Result);
683      end;
684  SetLength(aList,Result);
685end;
686
687procedure TMemIndexDB.CreateIndexerTables;
688begin
689  Clear;
690end;
691
692{ TMatches }
693
694function TMatches.GetM(AIndex : Integer): TMatch;
695begin
696  Result:=TMatch(Items[AIndex]);
697end;
698
699procedure TMatches.SetM(AIndex : Integer; AValue: TMatch);
700begin
701  Items[AIndex]:=AValue;
702end;
703
704function TMatches.AddMatch(AWord: TWordItem; AURL: TURLItem): TMatch;
705begin
706  Result:=TMatch(Add);
707  Result.URL:=AURl;
708  Result.Word:=AWord;
709end;
710
711{ TMatch }
712
713procedure TMatch.SetURL(AValue: TURLItem);
714begin
715  if FURL=AValue then exit;
716  If (FURL<>Nil) then
717    FURL.RemoveMatch(Self);
718  FURL:=AValue;
719  If (FURL<>Nil) then
720    FURL.AddMatch(Self);
721end;
722
723function TMatch.GetContext: UTF8string;
724begin
725  Result:=Description;
726end;
727
728procedure TMatch.SetContext(AValue: UTF8string);
729begin
730  Description:=AValue;
731end;
732
733procedure TMatch.SetWord(AValue: TWordItem);
734begin
735  if FWord=AValue then exit;
736  If (FWord<>Nil) then
737    FWord.RemoveMatch(Self);
738  FWord:=AValue;
739  If (FWord<>Nil) then
740    FWord.AddMatch(Self);
741end;
742
743function TMatch.BlockSize: Integer;
744begin
745  Result:=inherited BlockSize;
746  Result:=Result+SizeOf(FPosition)+2*SizeOf(Integer);
747end;
748
749procedure TMatch.WriteToStream(S: TStream);
750
751begin
752  inherited WriteToStream(S);
753  S.WriteBuffer(FPosition,Sizeof(FPosition));
754  WriteRefToStream(S,FWord);
755  WriteRefToStream(S,FUrl);
756end;
757
758procedure TMatch.Resolve(Words, URLS: TDescrCollection);
759begin
760  Word:=TWordItem(Words.Resolve(FWordID));
761  URL:=TURLItem(URLS.Resolve(FURLID));
762end;
763
764function TMatch.ReadFromStream(S: TStream): Integer;
765begin
766  Result:=inherited ReadFromStream(S);
767  S.ReadBuffer(FPosition,Sizeof(FPosition));
768  S.ReadBuffer(FWordID,SizeOf(FWordID));
769  S.ReadBuffer(FURLID,SizeOf(FURLID));
770end;
771
772{ TDescrCollection }
773
774function TDescrCollection.GetD(AIndex : Integer): TDescrItem;
775begin
776  Result:=TDescrItem(Items[AIndex])
777end;
778
779procedure TDescrCollection.SetD(AIndex : Integer; AValue: TDescrItem);
780begin
781  Items[AIndex]:=AValue;
782end;
783
784procedure TDescrCollection.RebuildHash;
785
786Var
787  I : Integer;
788  D : TDescrItem;
789
790begin
791  if FHash<>Nil then
792    FHash.Clear
793  else
794    FHash:=TFPhashList.Create;
795  For I:=0 to Count-1 do
796    begin
797    D:=GetD(I);
798    FHash.Add(D.Description,D);
799    end;
800end;
801
802function TDescrCollection.Resolve(AIndex: Integer): TDescrItem;
803begin
804  If (Aindex=-1) or (AIndex>=Count) then
805    Result:=Nil
806  else
807    Result:=TDescrItem(Items[AIndex]);
808end;
809
810destructor TDescrCollection.destroy;
811begin
812  FreeAndNil(FHash);
813  inherited destroy;
814end;
815
816
817procedure TDescrCollection.BeginLoading;
818begin
819  Inc(FLoadCount);
820end;
821
822procedure TDescrCollection.EndLoading;
823begin
824  if (FLoadCount>0) then
825    begin
826    Dec(FLoadCount);
827    If (FLoadCount=0) then
828      RebuildHash;
829    end;
830end;
831
832procedure TDescrCollection.AllocateIDS;
833
834Var
835  I : Integer;
836
837begin
838  For I:=0 to Count-1 do
839    GetD(i).TheID:=I;
840end;
841
842function TDescrCollection.FindDescr(const ADescription: UTF8string): TDescrItem;
843begin
844
845  If FHash=Nil then
846    Result:=Nil
847  else
848    Result:=TDescrItem(FHash.Find(ADescription));
849end;
850
851function TDescrCollection.AddDescr(const ADescription: UTF8string): TDescrItem;
852begin
853  Result:=Add as TDescrItem;
854  Result.Description:=ADescription;
855  if (FLoadCount=0) then
856    begin
857    If FHash=Nil then
858      ReBuildHash
859    else
860      FHash.Add(ADescription,Result);
861    end;
862end;
863
864
865
866{ TWordItem }
867
868function TMatchedItem.GetMatch(AIndex : Integer): TMatch;
869begin
870  Result:=TMatch(FList[AIndex]);
871end;
872
873function TMatchedItem.GetMatchCount: Integer;
874begin
875  Result:=FList.Count;
876end;
877
878function TMatchedItem.AddMatch(AMatch: TMatch): Integer;
879begin
880  Result:=FList.Add(AMatch);
881end;
882
883procedure TMatchedItem.RemoveMatch(AMatch: TMatch);
884begin
885  Flist.Remove(AMatch);
886end;
887
888constructor TMatchedItem.Create(ACollection: TCollection);
889begin
890  inherited Create(ACollection);
891  FList:=TFPList.Create;
892end;
893
894destructor TMatchedItem.Destroy;
895begin
896  FreeAndNil(Flist);
897  inherited Destroy;
898end;
899
900end.
901
902