Advertisement
Guest User

Hashes.pas by Ciaran McCreesh

a guest
Jun 24th, 2013
724
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 26.00 KB | None | 0 0
  1. unit Hashes;
  2.  
  3. {** Hash Library
  4.  
  5.     Original Author:     Ciaran McCreesh <keesh@users.sf.net>
  6.     Copyright:           Copyright (c) 2002 Ciaran McCreesh
  7.     Date:                20020621
  8.     Purpose:             A collection of hash components for Delphi. These are
  9.                          similar to arrays, but the index is a string. A hashing
  10.                          algorithm is used to provide extremely fast searching.
  11.  
  12.     Generic Moan:        This would be a lot easier if Delphi had template
  13.                          classes. If anyone at Borland / Inprise / whatever
  14.                          you're calling yourselves this week reads this, let me
  15.                          know how much I have to bribe you.
  16.  
  17.     Changelog:
  18.       v2.6 (20020621)
  19.         * Framework for dynamic bucket sizes. No actual resizing yet.
  20.         * Changed TStringHash, TIntegerHash and TObjectHash slightly, and fixed
  21.           potential bugs in them.
  22.         * General performance improvements
  23.         * Changed how iterators work. In particular, multiple iterators are now
  24.           possible. Thanks to Daniel Trinter for code and Emanuel for
  25.           suggestions.
  26.         + Previous method (goes with Next)
  27.         + AllowCompact property
  28.  
  29.       v2.5 (20020606)
  30.         * Empty hash keys explicitly forbidden. Thanks to Marco Vink for the
  31.           notice.
  32.         + Clear method
  33.  
  34.       v2.4 (20020603)
  35.         * Fixed Compact bug. Thanks to Daniel Trinter for the notice. Basically
  36.           I was assuming something about the size of one of the internal arrays
  37.           which wasn't always true.
  38.  
  39.       v2.3 (20020601)
  40.         + ItemCount property
  41.         + Compact method
  42.         * Hash auto-compacts itself if overly inefficient
  43.         * ItemIndexes are now recycled
  44.      
  45.       v2.2 (20020529)
  46.         * Fixed iterator bug. Not all items were called under some
  47.           circumstances. Thanks to Tom Walker for the notice.
  48.  
  49.       v2.1 (20020528, internal release only)
  50.         + TObjectHash
  51.  
  52.       v2.0 (20020526)
  53.         * Complete rewrite
  54.         + THash
  55.         + TStringHash
  56.         + TIntegerHash
  57.  
  58.     License:
  59.  
  60.       This library is Copyright (c) 2002 Ciaran McCreesh.
  61.  
  62.       Permission is granted to anyone to use this software for any purpose on
  63.       any computer system, and to redistribute it freely, subject to the
  64.       following restrictions:
  65.  
  66.       1. This software is distributed in the hope that it will be useful,
  67.          but WITHOUT ANY WARRANTY; without even the implied warranty of
  68.          MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  69.  
  70.       2. The origin of this software must not be misrepresented.
  71.  
  72.       3. Altered versions must be plainly marked as such, and must not be
  73.          misrepresented as being the original software.
  74.  
  75.     Documentation:
  76.       Please see:
  77.         * http://www.opensourcepan.co.uk/libraries/hashes/
  78.         * http://www.undu.com/articles/020604.html
  79.  
  80.     Other notes:
  81.       This unit provides three hashes, TIntegerHash, TStringHash and
  82.       TObjectHash. If you want a more precise kind (eg TComponentHash), it's
  83.       easiest to descend from THash and copy the TObjectHash code. Note that
  84.       TObjectHash is slightly different from TIntegerHash and TStringHash
  85.       because it has to free items -- it cannot just overwrite them.
  86.  
  87.     Internal data representation:
  88.       Each hash object has an array (potentially dynamically sized, but this
  89.       isn't used yet) of 'buckets' (dynamic arrays). Each bucket is mapped
  90.       to a series of hash values (we take the high order bits of the value
  91.       calculated), so that every possible hash value refers to exactly one
  92.       bucket. This reduces the amount of searching that has to be done to
  93.       find an item, so it's much faster than linear or B-Tree storage.
  94.  
  95.       Each bucket contains a series of integers. These are indexes into an
  96.       items array, which for type reasons is maintained by the descendant
  97.       classes. These are recycled when the hash detects that it is becoming
  98.       inefficient.
  99. }
  100.  
  101. interface
  102.  
  103.   uses SysUtils;
  104.  
  105.   const
  106.     {** This constant controls the initial size of the hash. }
  107.     c_HashInitialItemShift = 7;
  108.  
  109.     {** How inefficient do we have to be before we automatically Compact? }
  110.     c_HashCompactR         = 2;   { This many spaces per item. }
  111.     c_HashCompactM         = 100; { Never for less than this number of spaces. }
  112.  
  113.   type
  114.     {** General exception classes. }
  115.     EHashError = class(Exception);
  116. {    EHashErrorClass = class of EHashError;}
  117.  
  118.     {** Exception for when an item is not found. }
  119.     EHashFindError = class(EHashError);
  120.  
  121.     {** Exception for invalid Next op. }
  122.     EHashIterateError = class(EHashError);
  123.  
  124.     {** Exception for invalid keys. }
  125.     EHashInvalidKeyError = class(EHashError);
  126.  
  127.     {** Record, should really be private but OP won't let us... }
  128.     THashRecord = record
  129.       Hash: Cardinal;
  130.       ItemIndex: integer;
  131.       Key: string;
  132.     end;
  133.  
  134.     {** Iterator Record. This should also be private. This makes me almost like
  135.         the way Java does things. Almost. Maybe. }
  136.     THashIterator = record
  137.       ck, cx: integer;
  138.     end;
  139.  
  140.     {** Base Hash class. Don't use this directly. }
  141.     THash = class
  142.       protected
  143.         {** The keys. }
  144.         f_Keys: array of array of THashRecord;
  145.  
  146.         {** Current bucket shift. }
  147.         f_CurrentItemShift: integer;
  148.  
  149.         {** These are calculated from f_CurrentItemShift. }
  150.         f_CurrentItemCount: integer;
  151.         f_CurrentItemMask: integer;
  152.         f_CurrentItemMaxIdx: integer;
  153.  
  154.         {** Spare items. }
  155.         f_SpareItems: array of integer;
  156.  
  157.         {** Whether Next is allowed. }
  158.         f_NextAllowed: boolean;
  159.  
  160.         {** Current key. }
  161.         f_CurrentKey: string;
  162.  
  163.         {** Can we compact? }
  164.         f_AllowCompact: boolean;
  165.  
  166.         {** Our current iterator. }
  167.         f_CurrentIterator: THashIterator;
  168.  
  169.         {** Update the masks. }
  170.         procedure FUpdateMasks;
  171.  
  172.         {** Update the buckets. }
  173.         procedure FUpdateBuckets;
  174.  
  175.         {** Find a key's location. }
  176.         function FFindKey(const Key: string; var k, x: integer): boolean;
  177.  
  178.         {** Add a new key, or change an existing one. Don't call this directly. }
  179.         procedure FSetOrAddKey(const Key: string; ItemIndex: integer);
  180.  
  181.         {** Abstract method, delete value with a given index. Override this. }
  182.         procedure FDeleteIndex(i: integer); virtual; abstract;
  183.  
  184.         {** Get the number of items. }
  185.         function FGetItemCount: integer;
  186.  
  187.         {** Allocate an item index. }
  188.         function FAllocItemIndex: integer;
  189.  
  190.         {** Abstract method, move an item with index OldIndex to NewIndex.
  191.             Override this. }
  192.         procedure FMoveIndex(oldIndex, newIndex: integer); virtual; abstract;
  193.  
  194.         {** Abstract method, trim the indexes down to count items. Override
  195.             this. }
  196.         procedure FTrimIndexes(count: integer); virtual; abstract;
  197.  
  198.         {** Abstract method, clear all items. Override this. }
  199.         procedure FClearItems; virtual; abstract;
  200.  
  201.         {** Tell us where to start our compact count from. Override this. }
  202.         function FIndexMax: integer; virtual; abstract;
  203.  
  204.         {** Compact, but only if we're inefficient. }
  205.         procedure FAutoCompact;
  206.  
  207.       public
  208.         {** Our own constructor. }
  209.         constructor Create; reintroduce; virtual;
  210.  
  211.         {** Does a key exist? }
  212.         function Exists(const Key: string): boolean;
  213.  
  214.         {** Rename a key. }
  215.         procedure Rename(const Key, NewName: string);
  216.  
  217.         {** Delete a key. }
  218.         procedure Delete(const Key: string);
  219.  
  220.         {** Reset iterator. }
  221.         procedure Restart;
  222.  
  223.         {** Next key. }
  224.         function Next: boolean;
  225.  
  226.         {** Previous key. }
  227.         function Previous: boolean;
  228.  
  229.         {** Current key. }
  230.         function CurrentKey: string;
  231.  
  232.         {** The number of items. }
  233.         property ItemCount: integer read FGetItemCount;
  234.  
  235.         {** Compact the hash. }
  236.         procedure Compact;
  237.  
  238.         {** Clear the hash. }
  239.         procedure Clear;
  240.  
  241.         {** Allow compacting? }
  242.         property AllowCompact: boolean read f_AllowCompact write f_AllowCompact;
  243.  
  244.         {** Current iterator. }
  245.         property CurrentIterator: THashIterator read f_CurrentIterator write
  246.           f_CurrentIterator;
  247.  
  248.         {** Create a new iterator. }
  249.         function NewIterator: THashIterator;
  250.  
  251.     end;
  252.  
  253.     {** Hash of strings. }
  254.     TStringHash = class(THash)
  255.       protected
  256.         {** The index items. }
  257.         f_Items: array of string;
  258.  
  259.         {** Override FDeleteIndex abstract method. }
  260.         procedure FDeleteIndex(i: integer); override;
  261.  
  262.         {** Get an item or raise an exception. }
  263.         function FGetItem(const Key: string): string;
  264.  
  265.         {** Set or add an item. }
  266.         procedure FSetItem(const Key, Value: string);
  267.  
  268.         {** Move an index. }
  269.         procedure FMoveIndex(oldIndex, newIndex: integer); override;
  270.  
  271.         {** Trim. }
  272.         procedure FTrimIndexes(count: integer); override;
  273.  
  274.         {** Clear all items. }
  275.         procedure FClearItems; override;
  276.  
  277.         {** Where to start our compact count from. }
  278.         function FIndexMax: integer; override;
  279.  
  280.       public
  281.         {** Items property. }
  282.         property Items[const Key: string]: string read FGetItem
  283.           write FSetItem; default;
  284.     end;
  285.  
  286.     {** Hash of integers. }
  287.     TIntegerHash = class(THash)
  288.       protected
  289.         {** The index items. }
  290.         f_Items: array of integer;
  291.  
  292.         {** Override FDeleteIndex abstract method. }
  293.         procedure FDeleteIndex(i: integer); override;
  294.  
  295.         {** Get an item or raise an exception. }
  296.         function FGetItem(const Key: string): integer;
  297.  
  298.         {** Set or add an item. }
  299.         procedure FSetItem(const Key: string; Value: integer);
  300.  
  301.         {** Move an index. }
  302.         procedure FMoveIndex(oldIndex, newIndex: integer); override;
  303.  
  304.         {** Trim. }
  305.         procedure FTrimIndexes(count: integer); override;
  306.  
  307.         {** Clear all items. }
  308.         procedure FClearItems; override;
  309.  
  310.         {** Where to start our compact count from. }
  311.         function FIndexMax: integer; override;
  312.  
  313.       public
  314.         {** Items property. }
  315.         property Items[const Key: string]: integer read FGetItem
  316.           write FSetItem; default;
  317.     end;
  318.  
  319.     {** Hash of objects. }
  320.     TObjectHash = class(THash)
  321.       protected
  322.         {** The index items. }
  323.         f_Items: array of TObject;
  324.  
  325.         {** Override FDeleteIndex abstract method. }
  326.         procedure FDeleteIndex(i: integer); override;
  327.  
  328.         {** Get an item or raise an exception. }
  329.         function FGetItem(const Key: string): TObject;
  330.  
  331.         {** Set or add an item. }
  332.         procedure FSetItem(const Key: string; Value: TObject);
  333.  
  334.         {** Move an index. }
  335.         procedure FMoveIndex(oldIndex, newIndex: integer); override;
  336.  
  337.         {** Trim. }
  338.         procedure FTrimIndexes(count: integer); override;
  339.  
  340.         {** Clear all items. }
  341.         procedure FClearItems; override;
  342.  
  343.         {** Where to start our compact count from. }
  344.         function FIndexMax: integer; override;
  345.  
  346.       public
  347.         {** Items property. }
  348.         property Items[const Key: string]: TObject read FGetItem
  349.           write FSetItem; default;
  350.  
  351.         {** Destructor must destroy all items. }
  352.         destructor Destroy; override;
  353.  
  354.     end;
  355.  
  356. implementation
  357.  
  358.   {** A basic hash function. This is pretty fast, and fairly good general
  359.       purpose, but you may want to swap in a specialised version. }
  360.   function HashThis(const s: string): cardinal;
  361.   var
  362.     h, g, i: cardinal;
  363.   begin
  364.     if (s = '') then
  365.       raise EHashInvalidKeyError.Create('Key cannot be an empty string');
  366.     h := $12345670;
  367.     for i := 1 to Length(s) do begin
  368.       h := (h shl 4) + ord(s[i]);
  369.       g := h and $f0000000;
  370.       if (g > 0) then
  371.         h := h or (g shr 24) or g;
  372.     end;
  373.     result := h;
  374.   end;
  375.  
  376. { THash }
  377.  
  378. constructor THash.Create;
  379. begin
  380.   inherited Create;
  381.   self.f_CurrentIterator.ck := -1;
  382.   self.f_CurrentIterator.cx := 0;
  383.   self.f_CurrentItemShift := c_HashInitialItemShift;
  384.   self.FUpdateMasks;
  385.   self.FUpdateBuckets;
  386.   self.f_AllowCompact := true;
  387. end;
  388.  
  389. procedure THash.Delete(const Key: string);
  390. var
  391.   k, x, i: integer;
  392. begin
  393.   { Hash has been modified, so disallow Next. }
  394.   self.f_NextAllowed := false;
  395.   if (self.FFindKey(Key, k, x)) then begin
  396.     { Delete the Index entry. }
  397.     i := self.f_Keys[k][x].ItemIndex;
  398.     self.FDeleteIndex(i);
  399.     { Add the index to the Spares list. }
  400.     SetLength(self.f_SpareItems, Length(self.f_SpareItems) + 1);
  401.     self.f_SpareItems[High(self.f_SpareItems)] := i;
  402.     { Overwrite key with the last in the list. }
  403.     self.f_Keys[k][x] := self.f_Keys[k][High(self.f_Keys[k])];
  404.     { Delete the last in the list. }
  405.     SetLength(self.f_Keys[k], Length(self.f_Keys[k]) - 1);
  406.   end else
  407.     raise EHashFindError.CreateFmt('Key "%s" not found', [Key]);
  408.  
  409.   self.FAutoCompact;
  410. end;
  411.  
  412. function THash.Exists(const Key: string): boolean;
  413. var
  414.   dummy1, dummy2: integer;
  415. begin
  416.   result := FFindKey(Key, dummy1, dummy2);
  417. end;
  418.  
  419. procedure THash.FSetOrAddKey(const Key: string; ItemIndex: integer);
  420. var
  421.   k, x, i: integer;
  422. begin
  423.   { Exists already? }
  424.   if (self.FFindKey(Key, k, x)) then begin
  425.     { Yep. Delete the old stuff and set the new value. }
  426.     i := self.f_Keys[k][x].ItemIndex;
  427.     self.FDeleteIndex(i);
  428.     self.f_Keys[k][x].ItemIndex := ItemIndex;
  429.     { Add the index to the spares list. }
  430.     SetLength(self.f_SpareItems, Length(self.f_SpareItems) + 1);
  431.     self.f_SpareItems[High(self.f_SpareItems)] := i;
  432.   end else begin
  433.     { No, create a new one. }
  434.     SetLength(self.f_Keys[k], Length(self.f_Keys[k]) + 1);
  435.     self.f_Keys[k][High(self.f_Keys[k])].Key := Key;
  436.     self.f_Keys[k][High(self.f_Keys[k])].ItemIndex := ItemIndex;
  437.     self.f_Keys[k][High(self.f_Keys[k])].Hash := HashThis(Key);
  438.   end;
  439. end;
  440.  
  441. function THash.FFindKey(const Key: string; var k, x: integer): boolean;
  442. var
  443.   i: integer;
  444.   h: cardinal;
  445. begin
  446.   { Which bucket? }
  447.   h := HashThis(Key);
  448.   k := h and f_CurrentItemMask;
  449.   result := false;
  450.   { Look for it. }
  451.   for i := 0 to High(self.f_Keys[k]) do
  452.     if (self.f_Keys[k][i].Hash = h) or true then
  453.       if (self.f_Keys[k][i].Key = Key) then begin
  454.         { Found it! }
  455.         result := true;
  456.         x := i;
  457.         break;
  458.       end;
  459. end;
  460.  
  461. procedure THash.Rename(const Key, NewName: string);
  462. var
  463.   k, x, i: integer;
  464. begin
  465.   { Hash has been modified, so disallow Next. }
  466.   self.f_NextAllowed := false;
  467.   if (self.FFindKey(Key, k, x)) then begin
  468.     { Remember the ItemIndex. }
  469.     i := self.f_Keys[k][x].ItemIndex;
  470.     { Overwrite key with the last in the list. }
  471.     self.f_Keys[k][x] := self.f_Keys[k][High(self.f_Keys[k])];
  472.     { Delete the last in the list. }
  473.     SetLength(self.f_Keys[k], Length(self.f_Keys[k]) - 1);
  474.     { Create the new item. }
  475.     self.FSetOrAddKey(NewName, i);
  476.   end else
  477.     raise EHashFindError.CreateFmt('Key "%s" not found', [Key]);
  478.  
  479.   self.FAutoCompact;
  480. end;
  481.  
  482. function THash.CurrentKey: string;
  483. begin
  484.   if (not (self.f_NextAllowed)) then
  485.     raise EHashIterateError.Create('Cannot find CurrentKey as the hash has '
  486.       + 'been modified since Restart was called')
  487.   else if (self.f_CurrentKey = '') then
  488.     raise EHashIterateError.Create('Cannot find CurrentKey as Next has not yet '
  489.       + 'been called after Restart')
  490.   else
  491.     result := self.f_CurrentKey;
  492. end;
  493.  
  494. function THash.Next: boolean;
  495. begin
  496.   if (not (self.f_NextAllowed)) then
  497.     raise EHashIterateError.Create('Cannot get Next as the hash has '
  498.       + 'been modified since Restart was called');
  499.   result := false;
  500.   if (self.f_CurrentIterator.ck = -1) then begin
  501.     self.f_CurrentIterator.ck := 0;
  502.     self.f_CurrentIterator.cx := 0;
  503.   end;
  504.   while ((not result) and (self.f_CurrentIterator.ck <= f_CurrentItemMaxIdx)) do begin
  505.     if (self.f_CurrentIterator.cx < Length(self.f_Keys[self.f_CurrentIterator.ck])) then begin
  506.       result := true;
  507.       self.f_CurrentKey := self.f_Keys[self.f_CurrentIterator.ck][self.f_CurrentIterator.cx].Key;
  508.       inc(self.f_CurrentIterator.cx);
  509.     end else begin
  510.       inc(self.f_CurrentIterator.ck);
  511.       self.f_CurrentIterator.cx := 0;
  512.     end;
  513.   end;
  514. end;
  515.  
  516. procedure THash.Restart;
  517. begin
  518.   self.f_CurrentIterator.ck := -1;
  519.   self.f_CurrentIterator.cx := 0;
  520.   self.f_NextAllowed := true;
  521. end;
  522.  
  523. function THash.FGetItemCount: integer;
  524. var
  525.   i: integer;
  526. begin
  527.   { Calculate our item count. }
  528.   result := 0;
  529.   for i := 0 to f_CurrentItemMaxIdx do
  530.     inc(result, Length(self.f_Keys[i]));
  531. end;
  532.  
  533. function THash.FAllocItemIndex: integer;
  534. begin
  535.   if (Length(self.f_SpareItems) > 0) then begin
  536.     { Use the top SpareItem. }
  537.     result := self.f_SpareItems[High(self.f_SpareItems)];
  538.     SetLength(self.f_SpareItems, Length(self.f_SpareItems) - 1);
  539.   end else begin
  540.     result := self.FIndexMax + 1;
  541.   end;
  542. end;
  543.  
  544. procedure THash.Compact;
  545. var
  546.   aSpaces: array of boolean;
  547.   aMapping: array of integer;
  548.   i, j: integer;
  549. begin
  550.   { Find out where the gaps are. We could do this by sorting, but that's at
  551.     least O(n log n), and sometimes O(n^2), so we'll go for the O(n) method,
  552.     even though it involves multiple passes. Note that this is a lot faster
  553.     than it looks. Disabling this saves about 3% in my benchmarks, but uses a
  554.     lot more memory. }
  555.   if (self.AllowCompact) then begin
  556.     SetLength(aSpaces, self.FIndexMax + 1);
  557.     SetLength(aMapping, self.FIndexMax + 1);
  558.     for i := 0 to High(aSpaces) do
  559.       aSpaces[i] := false;
  560.     for i := 0 to High(aMapping) do
  561.       aMapping[i] := i;
  562.     for i := 0 to High(self.f_SpareItems) do
  563.       aSpaces[self.f_SpareItems[i]] := true;
  564.  
  565.     { Starting at the low indexes, fill empty ones from the high indexes. }
  566.     i := 0;
  567.     j := self.FIndexMax;
  568.     while (i < j) do begin
  569.       if (aSpaces[i]) then begin
  570.         while ((i < j) and (aSpaces[j])) do
  571.           dec(j);
  572.         if (i < j) then begin
  573.           aSpaces[i] := false;
  574.           aSpaces[j] := true;
  575.           self.FMoveIndex(j, i);
  576.           aMapping[j] := i
  577.         end;
  578.       end else
  579.         inc(i);
  580.     end;
  581.  
  582.     j := self.FIndexMax;
  583.     while (aSpaces[j]) do
  584.       dec(j);
  585.  
  586.     { Trim the items array down to size. }
  587.     self.FTrimIndexes(j + 1);
  588.  
  589.     { Clear the spaces. }
  590.     SetLength(self.f_SpareItems, 0);
  591.  
  592.     { Update our buckets. }
  593.     for i := 0 to f_CurrentItemMaxIdx do
  594.       for j := 0 to High(self.f_Keys[i]) do
  595.         self.f_Keys[i][j].ItemIndex := aMapping[self.f_Keys[i][j].ItemIndex];
  596.   end;
  597. end;
  598.  
  599. procedure THash.FAutoCompact;
  600. begin
  601.   if (self.AllowCompact) then
  602.     if (Length(self.f_SpareItems) >= c_HashCompactM) then
  603.       if (self.FIndexMax * c_HashCompactR > Length(self.f_SpareItems)) then
  604.         self.Compact;
  605. end;
  606.  
  607. procedure THash.Clear;
  608. var
  609.   i: integer;
  610. begin
  611.   self.FClearItems;
  612.   SetLength(self.f_SpareItems, 0);
  613.   for i := 0 to f_CurrentItemMaxIdx do
  614.     SetLength(self.f_Keys[i], 0);
  615. end;
  616.  
  617. procedure THash.FUpdateMasks;
  618. begin
  619.   f_CurrentItemMask := (1 shl f_CurrentItemShift) - 1;
  620.   f_CurrentItemMaxIdx := (1 shl f_CurrentItemShift) - 1;
  621.   f_CurrentItemCount := (1 shl f_CurrentItemShift);
  622. end;
  623.  
  624. procedure THash.FUpdateBuckets;
  625. begin
  626.   { This is just a temporary thing. }
  627.   SetLength(self.f_Keys, self.f_CurrentItemCount);
  628. end;
  629.  
  630. function THash.NewIterator: THashIterator;
  631. begin
  632.   result.ck := -1;
  633.   result.cx := 0;
  634. end;
  635.  
  636. function THash.Previous: boolean;
  637. begin
  638.   if (not (self.f_NextAllowed)) then
  639.     raise EHashIterateError.Create('Cannot get Next as the hash has '
  640.       + 'been modified since Restart was called');
  641.   result := false;
  642.   if (self.f_CurrentIterator.ck >= 0) then begin
  643.     while ((not result) and (self.f_CurrentIterator.ck >= 0)) do begin
  644.       dec(self.f_CurrentIterator.cx);
  645.       if (self.f_CurrentIterator.cx >= 0) then begin
  646.         result := true;
  647.         self.f_CurrentKey := self.f_Keys[self.f_CurrentIterator.ck][self.f_CurrentIterator.cx].Key;
  648.       end else begin
  649.         dec(self.f_CurrentIterator.ck);
  650.         if (self.f_CurrentIterator.ck >= 0) then
  651.           self.f_CurrentIterator.cx := Length(self.f_Keys[self.f_CurrentIterator.ck]);
  652.       end;
  653.     end;
  654.   end;
  655. end;
  656.  
  657. { TStringHash }
  658.  
  659. procedure TStringHash.FDeleteIndex(i: integer);
  660. begin
  661.   self.f_Items[i] := '';
  662. end;
  663.  
  664. function TStringHash.FGetItem(const Key: string): string;
  665. var
  666.   k, x: integer;
  667. begin
  668.   if (self.FFindKey(Key, k, x)) then
  669.     result := self.f_Items[self.f_Keys[k][x].ItemIndex]
  670.   else
  671.     raise EHashFindError.CreateFmt('Key "%s" not found', [Key]);
  672. end;
  673.  
  674. procedure TStringHash.FMoveIndex(oldIndex, newIndex: integer);
  675. begin
  676.   self.f_Items[newIndex] := self.f_Items[oldIndex];
  677. end;
  678.  
  679. procedure TStringHash.FSetItem(const Key, Value: string);
  680. var
  681.   k, x, i: integer;
  682. begin
  683.   if (self.FFindKey(Key, k, x)) then
  684.     self.f_Items[self.f_Keys[k][x].ItemIndex] := Value
  685.   else begin
  686.     { New index entry, or recycle an old one. }
  687.     i := self.FAllocItemIndex;
  688.     if (i > High(self.f_Items)) then
  689.       SetLength(self.f_Items, i + 1);
  690.     self.f_Items[i] := Value;
  691.     { Add it to the hash. }
  692.     SetLength(self.f_Keys[k], Length(self.f_Keys[k]) + 1);
  693.     self.f_Keys[k][High(self.f_Keys[k])].Key := Key;
  694.     self.f_Keys[k][High(self.f_Keys[k])].ItemIndex := i;
  695.     self.f_Keys[k][High(self.f_Keys[k])].Hash := HashThis(Key);
  696.     { Hash has been modified, so disallow Next. }
  697.     self.f_NextAllowed := false;
  698.   end;
  699. end;
  700.  
  701. function TStringHash.FIndexMax: integer;
  702. begin
  703.   result := High(self.f_Items);
  704. end;
  705.  
  706. procedure TStringHash.FTrimIndexes(count: integer);
  707. begin
  708.   SetLength(self.f_Items, count);
  709. end;
  710.  
  711. procedure TStringHash.FClearItems;
  712. begin
  713.   SetLength(self.f_Items, 0);
  714. end;
  715.  
  716. { TIntegerHash }
  717.  
  718. procedure TIntegerHash.FDeleteIndex(i: integer);
  719. begin
  720.   self.f_Items[i] := 0;
  721. end;
  722.  
  723. function TIntegerHash.FGetItem(const Key: string): integer;
  724. var
  725.   k, x: integer;
  726. begin
  727.   if (self.FFindKey(Key, k, x)) then
  728.     result := self.f_Items[self.f_Keys[k][x].ItemIndex]
  729.   else
  730.     raise EHashFindError.CreateFmt('Key "%s" not found', [Key]);
  731. end;
  732.  
  733. procedure TIntegerHash.FMoveIndex(oldIndex, newIndex: integer);
  734. begin
  735.   self.f_Items[newIndex] := self.f_Items[oldIndex];
  736. end;
  737.  
  738. procedure TIntegerHash.FSetItem(const Key: string; Value: integer);
  739. var
  740.   k, x, i: integer;
  741. begin
  742.   if (self.FFindKey(Key, k, x)) then
  743.     self.f_Items[self.f_Keys[k][x].ItemIndex] := Value
  744.   else begin
  745.     { New index entry, or recycle an old one. }
  746.     i := self.FAllocItemIndex;
  747.     if (i > High(self.f_Items)) then
  748.       SetLength(self.f_Items, i + 1);
  749.     self.f_Items[i] := Value;
  750.     { Add it to the hash. }
  751.     SetLength(self.f_Keys[k], Length(self.f_Keys[k]) + 1);
  752.     self.f_Keys[k][High(self.f_Keys[k])].Key := Key;
  753.     self.f_Keys[k][High(self.f_Keys[k])].ItemIndex := i;
  754.     self.f_Keys[k][High(self.f_Keys[k])].Hash := HashThis(Key);
  755.     { Hash has been modified, so disallow Next. }
  756.     self.f_NextAllowed := false;
  757.   end;
  758. end;
  759.  
  760. function TIntegerHash.FIndexMax: integer;
  761. begin
  762.   result := High(self.f_Items);
  763. end;
  764.  
  765. procedure TIntegerHash.FTrimIndexes(count: integer);
  766. begin
  767.   SetLength(self.f_Items, count);
  768. end;
  769.  
  770. procedure TIntegerHash.FClearItems;
  771. begin
  772.   SetLength(self.f_Items, 0);
  773. end;
  774.  
  775. { TObjectHash }
  776.  
  777. procedure TObjectHash.FDeleteIndex(i: integer);
  778. begin
  779.   self.f_Items[i].Free;
  780.   self.f_Items[i] := nil;
  781. end;
  782.  
  783. function TObjectHash.FGetItem(const Key: string): TObject;
  784. var
  785.   k, x: integer;
  786. begin
  787.   if (self.FFindKey(Key, k, x)) then
  788.     result := self.f_Items[self.f_Keys[k][x].ItemIndex]
  789.   else
  790.     raise EHashFindError.CreateFmt('Key "%s" not found', [Key]);
  791. end;
  792.  
  793. procedure TObjectHash.FMoveIndex(oldIndex, newIndex: integer);
  794. begin
  795.   self.f_Items[newIndex] := self.f_Items[oldIndex];
  796. end;
  797.  
  798. procedure TObjectHash.FSetItem(const Key: string; Value: TObject);
  799. var
  800.   k, x, i: integer;
  801. begin
  802.   if (self.FFindKey(Key, k, x)) then begin
  803.     self.f_Items[self.f_Keys[k][x].ItemIndex].Free;
  804.     self.f_Items[self.f_Keys[k][x].ItemIndex] := Value;
  805.   end else begin
  806.     { New index entry, or recycle an old one. }
  807.     i := self.FAllocItemIndex;
  808.     if (i > High(self.f_Items)) then
  809.       SetLength(self.f_Items, i + 1);
  810.     self.f_Items[i] := Value;
  811.     { Add it to the hash. }
  812.     SetLength(self.f_Keys[k], Length(self.f_Keys[k]) + 1);
  813.     self.f_Keys[k][High(self.f_Keys[k])].Key := Key;
  814.     self.f_Keys[k][High(self.f_Keys[k])].ItemIndex := i;
  815.     self.f_Keys[k][High(self.f_Keys[k])].Hash := HashThis(Key);
  816.     { Hash has been modified, so disallow Next. }
  817.     self.f_NextAllowed := false;
  818.   end;
  819. end;
  820.  
  821. function TObjectHash.FIndexMax: integer;
  822. begin
  823.   result := High(self.f_Items);
  824. end;
  825.  
  826. procedure TObjectHash.FTrimIndexes(count: integer);
  827. begin
  828.   SetLength(self.f_Items, count);
  829. end;
  830.  
  831. procedure TObjectHash.FClearItems;
  832. var
  833.   i: integer;
  834. begin
  835.   for i := 0 to High(self.f_Items) do
  836.     if (Assigned(self.f_Items[i])) then
  837.       self.f_Items[i].Free;
  838.   SetLength(self.f_Items, 0);
  839. end;
  840.  
  841. destructor TObjectHash.Destroy;
  842. var
  843.   i: integer;
  844. begin
  845.   for i := 0 to High(self.f_Items) do
  846.     if (Assigned(self.f_Items[i])) then
  847.       self.f_Items[i].Free;
  848.   inherited;
  849. end;
  850.  
  851. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement