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