hashes.pas

分析torrent的东西是拿别人的

unit Hashes;

{** Hash Library

    Original Author:     Ciaran McCreesh <[e-mail]>
    Copyright:           Copyright (c) 2002 Ciaran McCreesh
    Date:                20020621
    Purpose:             A collection of hash components for Delphi. These are
                         similar to arrays, but the index is a string. A hashing
                         algorithm is used to provide extremely fast searching.

    Generic Moan:        This would be a lot easier if Delphi had template
                         classes. If anyone at Borland / Inprise / whatever
                         you're calling yourselves this week reads this, let me
                         know how much I have to bribe you.

    Changelog:
      v2.6 (20020621)
        * Framework for dynamic bucket sizes. No actual resizing yet.
        * Changed TStringHash, TIntegerHash and TObjectHash slightly, and fixed
          potential bugs in them.
        * General performance improvements
        * Changed how iterators work. In particular, multiple iterators are now
          possible. Thanks to Daniel Trinter for code and Emanuel for
          suggestions.
        + Previous method (goes with Next)
        + AllowCompact property

      v2.5 (20020606)
        * Empty hash keys explicitly forbidden. Thanks to Marco Vink for the
          notice.
        + Clear method

      v2.4 (20020603)
        * Fixed Compact bug. Thanks to Daniel Trinter for the notice. Basically
          I was assuming something about the size of one of the internal arrays
          which wasn't always true.

      v2.3 (20020601)
        + ItemCount property
        + Compact method
        * Hash auto-compacts itself if overly inefficient
        * ItemIndexes are now recycled
    
      v2.2 (20020529)
        * Fixed iterator bug. Not all items were called under some
          circumstances. Thanks to Tom Walker for the notice.

      v2.1 (20020528, internal release only)
        + TObjectHash

      v2.0 (20020526)
        * Complete rewrite
        + THash
        + TStringHash
        + TIntegerHash

    License:

      This library is Copyright (c) 2002 Ciaran McCreesh.

      Permission is granted to anyone to use this software for any purpose on
      any computer system, and to redistribute it freely, subject to the
      following restrictions:

      1. This software is distributed in the hope that it will be useful,
         but WITHOUT ANY WARRANTY; without even the implied warranty of
         MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

      2. The origin of this software must not be misrepresented.

      3. Altered versions must be plainly marked as such, and must not be
         misrepresented as being the original software.

    Documentation:
      Please see:
        * http://www.opensourcepan.co.uk/libraries/hashes/
        * http://www.undu.com/articles/020604.html

    Other notes:
      This unit provides three hashes, TIntegerHash, TStringHash and
      TObjectHash. If you want a more precise kind (eg TComponentHash), it's
      easiest to descend from THash and copy the TObjectHash code. Note that
      TObjectHash is slightly different from TIntegerHash and TStringHash
      because it has to free items -- it cannot just overwrite them.

    Internal data representation:
      Each hash object has an array (potentially dynamically sized, but this
      isn't used yet) of 'buckets' (dynamic arrays). Each bucket is mapped
      to a series of hash values (we take the high order bits of the value
      calculated), so that every possible hash value refers to exactly one
      bucket. This reduces the amount of searching that has to be done to
      find an item, so it's much faster than linear or B-Tree storage.

      Each bucket contains a series of integers. These are indexes into an
      items array, which for type reasons is maintained by the descendant
      classes. These are recycled when the hash detects that it is becoming
      inefficient.
}

interface

  uses SysUtils;

  const
    {** This constant controls the initial size of the hash. }
    c_HashInitialItemShift = 7;

    {** How inefficient do we have to be before we automatically Compact? }
    c_HashCompactR         = 2;   { This many spaces per item. }
    c_HashCompactM         = 100; { Never for less than this number of spaces. }

  type
    {** General exception classes. }
    EHashError = class(Exception);
{    EHashErrorClass = class of EHashError;}

    {** Exception for when an item is not found. }
    EHashFindError = class(EHashError);

    {** Exception for invalid Next op. }
    EHashIterateError = class(EHashError);

    {** Exception for invalid keys. }
    EHashInvalidKeyError = class(EHashError);

    {** Record, should really be private but OP won't let us... }
    THashRecord = record
      Hash: Cardinal;
      ItemIndex: integer;
      Key: string;
    end;

    {** Iterator Record. This should also be private. This makes me almost like
        the way Java does things. Almost. Maybe. }
    THashIterator = record
      ck, cx: integer;
    end;

    {** Base Hash class. Don't use this directly. }
    THash = class
      protected
        {** The keys. }
        f_Keys: array of array of THashRecord;

        {** Current bucket shift. }
        f_CurrentItemShift: integer;

        {** These are calculated from f_CurrentItemShift. }
        f_CurrentItemCount: integer;
        f_CurrentItemMask: integer;
        f_CurrentItemMaxIdx: integer;

        {** Spare items. }
        f_SpareItems: array of integer;

        {** Whether Next is allowed. }
        f_NextAllowed: boolean;

        {** Current key. }
        f_CurrentKey: string;

        {** Can we compact? }
        f_AllowCompact: boolean;

        {** Our current iterator. }
        f_CurrentIterator: THashIterator;

        {** Update the masks. }
        procedure FUpdateMasks;

        {** Update the buckets. }
        procedure FUpdateBuckets;

        {** Find a key's location. }
        function FFindKey(const Key: string; var k, x: integer): boolean;

        {** Add a new key, or change an existing one. Don't call this directly. }
        procedure FSetOrAddKey(const Key: string; ItemIndex: integer);

        {** Abstract method, delete value with a given index. Override this. }
        procedure FDeleteIndex(i: integer); virtual; abstract;

        {** Get the number of items. }
        function FGetItemCount: integer;

        {** Allocate an item index. }
        function FAllocItemIndex: integer;

        {** Abstract method, move an item with index OldIndex to NewIndex.
            Override this. }
        procedure FMoveIndex(oldIndex, newIndex: integer); virtual; abstract;

        {** Abstract method, trim the indexes down to count items. Override
            this. }
        procedure FTrimIndexes(count: integer); virtual; abstract;

        {** Abstract method, clear all items. Override this. }
        procedure FClearItems; virtual; abstract;

        {** Tell us where to start our compact count from. Override this. }
        function FIndexMax: integer; virtual; abstract;

        {** Compact, but only if we're inefficient. }
        procedure FAutoCompact;

      public
        {** Our own constructor. }
        constructor Create; reintroduce; virtual;

        {** Does a key exist? }
        function Exists(const Key: string): boolean;

        {** Rename a key. }
        procedure Rename(const Key, NewName: string);

        {** Delete a key. }
        procedure Delete(const Key: string);

        {** Reset iterator. }
        procedure Restart;

        {** Next key. }
        function Next: boolean;

        {** Previous key. }
        function Previous: boolean;

        {** Current key. }
        function CurrentKey: string;

        {** The number of items. }
        property ItemCount: integer read FGetItemCount;

        {** Compact the hash. }
        procedure Compact;

        {** Clear the hash. }
        procedure Clear;

        {** Allow compacting? }
        property AllowCompact: boolean read f_AllowCompact write f_AllowCompact;

        {** Current iterator. }
        property CurrentIterator: THashIterator read f_CurrentIterator write
          f_CurrentIterator;

        {** Create a new iterator. }
        function NewIterator: THashIterator;

    end;

    {** Hash of strings. }
    TStringHash = class(THash)
      protected
        {** The index items. }
        f_Items: array of string;

        {** Override FDeleteIndex abstract method. }
        procedure FDeleteIndex(i: integer); override;

        {** Get an item or raise an exception. }
        function FGetItem(const Key: string): string;

        {** Set or add an item. }
        procedure FSetItem(const Key, Value: string);

        {** Move an index. }
        procedure FMoveIndex(oldIndex, newIndex: integer); override;

        {** Trim. }
        procedure FTrimIndexes(count: integer); override;

        {** Clear all items. }
        procedure FClearItems; override;

        {** Where to start our compact count from. }
        function FIndexMax: integer; override;

      public
        {** Items property. }
        property Items[const Key: string]: string read FGetItem
          write FSetItem; default;
    end;

    {** Hash of integers. }
    TIntegerHash = class(THash)
      protected
        {** The index items. }
        f_Items: array of integer;

        {** Override FDeleteIndex abstract method. }
        procedure FDeleteIndex(i: integer); override;

        {** Get an item or raise an exception. }
        function FGetItem(const Key: string): integer;

        {** Set or add an item. }
        procedure FSetItem(const Key: string; Value: integer);

        {** Move an index. }
        procedure FMoveIndex(oldIndex, newIndex: integer); override;

        {** Trim. }
        procedure FTrimIndexes(count: integer); override;

        {** Clear all items. }
        procedure FClearItems; override;

        {** Where to start our compact count from. }
        function FIndexMax: integer; override;

      public
        {** Items property. }
        property Items[const Key: string]: integer read FGetItem
          write FSetItem; default;
    end;

    {** Hash of objects. }
    TObjectHash = class(THash)
      protected
        {** The index items. }
        f_Items: array of TObject;

        {** Override FDeleteIndex abstract method. }
        procedure FDeleteIndex(i: integer); override;

        {** Get an item or raise an exception. }
        function FGetItem(const Key: string): TObject;

        {** Set or add an item. }
        procedure FSetItem(const Key: string; Value: TObject);

        {** Move an index. }
        procedure FMoveIndex(oldIndex, newIndex: integer); override;

        {** Trim. }
        procedure FTrimIndexes(count: integer); override;

        {** Clear all items. }
        procedure FClearItems; override;

        {** Where to start our compact count from. }
        function FIndexMax: integer; override;

      public
        {** Items property. }
        property Items[const Key: string]: TObject read FGetItem
          write FSetItem; default;

        {** Destructor must destroy all items. }
        destructor Destroy; override;

    end;

implementation

  {** A basic hash function. This is pretty fast, and fairly good general
      purpose, but you may want to swap in a specialised version. }
  function HashThis(const s: string): cardinal;
  var
    h, g, i: cardinal;
  begin
    if (s = '') then
      raise EHashInvalidKeyError.Create('Key cannot be an empty string');
    h := $12345670;
    for i := 1 to Length(s) do begin
      h := (h shl 4) + ord(s[i]);
      g := h and $f0000000;
      if (g > 0) then
        h := h or (g shr 24) or g;
    end;
    result := h;
  end;

{ THash }

constructor THash.Create;
begin
  inherited Create;
  self.f_CurrentIterator.ck := -1;
  self.f_CurrentIterator.cx := 0;
  self.f_CurrentItemShift := c_HashInitialItemShift;
  self.FUpdateMasks;
  self.FUpdateBuckets;
  self.f_AllowCompact := true;
end;

procedure THash.Delete(const Key: string);
var
  k, x, i: integer;
begin
  { Hash has been modified, so disallow Next. }
  self.f_NextAllowed := false;
  if (self.FFindKey(Key, k, x)) then begin
    { Delete the Index entry. }
    i := self.f_Keys[k][x].ItemIndex;
    self.FDeleteIndex(i);
    { Add the index to the Spares list. }
    SetLength(self.f_SpareItems, Length(self.f_SpareItems) + 1);
    self.f_SpareItems[High(self.f_SpareItems)] := i;
    { Overwrite key with the last in the list. }
    self.f_Keys[k][x] := self.f_Keys[k][High(self.f_Keys[k])];
    { Delete the last in the list. }
    SetLength(self.f_Keys[k], Length(self.f_Keys[k]) - 1);
  end else
    raise EHashFindError.CreateFmt('Key "%s" not found', [Key]);

  self.FAutoCompact;
end;

function THash.Exists(const Key: string): boolean;
var
  dummy1, dummy2: integer;
begin
  result := FFindKey(Key, dummy1, dummy2);
end;

procedure THash.FSetOrAddKey(const Key: string; ItemIndex: integer);
var
  k, x, i: integer;
begin
  { Exists already? }
  if (self.FFindKey(Key, k, x)) then begin
    { Yep. Delete the old stuff and set the new value. }
    i := self.f_Keys[k][x].ItemIndex;
    self.FDeleteIndex(i);