ethash.pas

a voice guide client ,it is the second part of voice guide center

{
  $create by mous 2006-03-18,
    哈希表数据结构,非线程安全
    由 IniFiles 里面的 StringHash 改写而来
    支持 Integer / String 作为 Key 的哈希表
    Value 类型 可以为 Integer / Pointer / Object

    说明: 如果容量是一个素数,那么它的效率最好

....这些东西，本来假如用 C++ 的话，能够从 STL 中直接获取，不需要自己来在写......
}

unit etHash;

interface

uses
  classes
  ;

type

  //////////////////////////////////////////////////////////////////////////////
  // 整数为关键字的哈希表记录
  PPEtIntHashItem = ^PEtIntHashItem;
  PEtIntHashItem  = ^TEtIntHashItem;
  TEtIntHashItem  = record
    Next          : PEtIntHashItem;
    Key           : Integer;
    Value         : Pointer;
  end;

  // 哈希表项目数据类型
  TEtHashItemType = ( etHitInteger, etHitPointer, etHitObject );

  TMethodOnIntHashItem  = procedure( const _key: Integer; const _val: Pointer ) of object;
  TProcOnIntHashItem    = procedure( const _key: Integer; const _val: Pointer );

  // Int 哈希表类型
  TEtIntHashTable = class
  private
    FValueType  : TEtHashItemType;
    IntBuckets  : array of PEtIntHashItem;

    FCount      : Cardinal;
    FChanged    : Boolean;

    procedure   CleanItem( item : PEtIntHashItem );
  public
    constructor Create( vType: TEtHashItemType; Size: Cardinal = 255 );
    destructor  Destroy; override;

    class function  HashOf(const Key: Integer ): Integer;

    procedure   Clear( flag: Boolean = false );

    procedure   Remove(const Key: Integer);
    function    ValueOf(const Key: Integer): Pointer;
    procedure   Add(const Key: Integer; Value: Pointer  );
    function    Find(const Key: Integer   ): PPEtIntHashItem;
    procedure   SetValue(const Key: Integer; Value: Pointer);
    function    Modify(const Key: Integer; Value: Pointer ): Boolean;
    procedure   DoOnEachItem( _proc: TMethodOnIntHashItem ); overload;
    procedure   ProcEachItem( _proc: TProcOnIntHashItem ); overload;
    property    Count: Cardinal read FCount;
  end;

  // 字符串为关键字的哈希表记录
  PPEtStrHashItem = ^PEtStrHashItem;
  PEtStrHashItem  = ^TEtStrHashItem;
  TEtStrHashItem  = record
    Next          : PEtStrHashItem;
    Key           : String;
    Value         : Pointer;
  end;
  TProcOnStrHashItem = procedure( const _key: String; const _val: Pointer ) of object;
  
  // Str 哈希表类型
  TEtStrHashTable = class
  private
    FValueType  : TEtHashItemType;
    StrBuckets  : array of PEtStrHashItem;

    FCount      : Cardinal;
    FChanged    : Boolean;

    procedure   CleanItem( item : PEtStrHashItem );
  public
    constructor Create( vType: TEtHashItemType; Size: Cardinal = 255 );
    destructor  Destroy; override;

    class function  HashOf(const Key: String ): Integer;

    procedure   Clear( flag: Boolean = false );

    procedure   Remove(const Key: String );
    function    ValueOf(const Key: String ): Pointer;
    procedure   Add(const Key: String; Value: Pointer  );
    function    Find(const Key: String    ): PPEtStrHashItem;
    procedure   SetValue(const Key: String; Value: Pointer );
    function    Modify(const Key: String; Value: Pointer ): Boolean;
    procedure   DoOnEachItem( _proc: TProcOnStrHashItem );
    
    property    Count: Cardinal read FCount;
  end;

implementation

function  isPrimeNumber( _n: Cardinal ): Boolean;
{ 判断一个数值是否为素数
}
var
  i : Integer;
begin
  if _n = 1 then  Result  := True
  else if _n = 2 then Result  := True
  
end;

{ TIntHash }

{ 以下是 TEtIntHash 的定义 }
(*----------------------------------------------------------------------------*)
procedure TEtIntHashTable.Add(const Key: Integer; Value: Pointer );
var
  Hash          : Integer;
  Bucket        : PEtIntHashItem;
  tmp_pt        : Pointer;
begin
  tmp_pt := ValueOf( Key );
  if tmp_pt <> nil then
    Exit;

  Hash          := HashOf( Key ) mod Integer( Length(IntBuckets) );

  New(Bucket);
  Bucket^.Key   := Key;
  Bucket^.Value := Value;
  Bucket^.Next  := IntBuckets[Hash];
  IntBuckets[Hash] := Bucket;
  
  Inc( FCount );
  FChanged  := True;
end;

procedure TEtStrHashTable.Add(const Key: String; Value: Pointer );
var
  Hash          : Integer;
  Bucket        : PEtStrHashItem;
  tmp_pt        : Pointer;
begin
  tmp_pt := ValueOf( Key );
  if tmp_pt <> nil then
    Exit;

  Hash          := HashOf( Key ) mod Integer( Length(StrBuckets) );

  New(Bucket);
  Bucket^.Key   := Key;
  Bucket^.Value := Value;
  Bucket^.Next  := StrBuckets[Hash];
  StrBuckets[Hash] := Bucket;

  Inc( FCount );
  FChanged  := True;
end;

procedure TEtIntHashTable.CleanItem( item: PEtIntHashItem);
var
  p   : Pointer;
  obj : TObject;
begin
  p   := Pointer( item^.Value );
  obj := p;

  case FValueType of
    etHitInteger  : ;
    ethitPointer  : Dispose( p );
    ethitObject   : obj.Free;
  end;
end;

procedure TEtStrHashTable.CleanItem( item: PEtStrHashItem );
var
  p   : Pointer;
  obj : TObject;
begin
  p   := Pointer( item^.Value );
  obj := p;

  case FValueType of
    ethitPointer : Dispose( p );
    ethitObject  : obj.Free;
  end;
end;

procedure TEtIntHashTable.Clear( flag: Boolean );
var
  I       : Integer;
  Pi, Ni  : PEtIntHashItem;
begin
  for I := 0 to Length(IntBuckets) - 1 do
  begin
    Pi := IntBuckets[I];
    while Pi <> nil do
    begin
      Ni := Pi^.Next;

      if flag then CleanItem( pi );

      Dispose(Pi);
      Pi := Ni;
    end;
    IntBuckets[I] := nil;
  end;

  FCount    := 0;
  FChanged  := True;
end;

procedure TEtStrHashTable.Clear( flag: Boolean );
var
  I       : Integer;
  Ps, Ns  : PEtStrHashItem;
begin

  for I := 0 to Length(StrBuckets) - 1 do
  begin
    Ps := StrBuckets[I];
    while Ps <> nil do
    begin
      Ns := Ps^.Next;

      if flag then CleanItem( ps );

      Dispose(Ps);
      Ps := Ns;
    end;
    StrBuckets[I] := nil;
  end;

  FCount    := 0; 
  FChanged  := True;
end;
       
constructor TEtIntHashTable.Create( vType: TEtHashItemType; Size: Cardinal);
begin
  inherited Create;

  FValueType      := vType;
  FCount          := 0;
  FChanged        := False;
  SetLength( IntBuckets, Size );
end;

constructor TEtStrHashTable.Create( vType: TEtHashItemType; Size: Cardinal);
begin
  inherited Create;

  FValueType      := vType;
  FCount          := 0;
  FChanged        := False;
  SetLength( StrBuckets, Size );
end;

destructor TEtIntHashTable.Destroy;
begin
  Clear( True );
  inherited Destroy;
end;

destructor TEtStrHashTable.Destroy;
begin
  Clear( True );
  inherited Destroy;
end;

function TEtIntHashTable.Find(const Key: Integer): PPEtIntHashItem;
var
  Hash: Integer;
begin

  Hash := HashOf( Key ) mod Integer( Length(IntBuckets) );

  Result := @IntBuckets[Hash];
  while Result^ <> nil do
  begin
    if Result^.Key = Key then
      Exit
    else
      Result := @Result^.Next;
  end;
end;

function TEtStrHashTable.Find(const Key: String): PPEtStrHashItem;
var
  Hash: Integer;
begin

  Hash := HashOf( Key ) mod Integer( Length(StrBuckets) );

  Result := @StrBuckets[Hash];
  while Result^ <> nil do
  begin
    if Result^.Key = Key then
      Exit
    else
      Result := @Result^.Next;
  end;
end;

class function TEtIntHashTable.HashOf(const Key: Integer): Integer;
begin
  Result  := Abs( Key );// + 1;
end;

class function TEtStrHashTable.HashOf(const Key: String): Integer;
var
  I: Integer;
begin
  Result := 0;
  for I := 1 to Length(Key) do
    Result := ((Result shl 2) or (Result shr (SizeOf(Result) * 8 - 2))) xor
      Ord(Key[I]);
end;

function TEtIntHashTable.Modify(const Key: Integer; Value: Pointer ): Boolean;
var
  P: PEtIntHashItem;
begin         
  P := Find(Key)^;

  if P <> nil then
  begin
    Result := True;
    P^.Value := Value;
  end
  else
    Result := False;
end;

function TEtStrHashTable.Modify(const Key: String; Value: Pointer ): Boolean;
var
  P: PEtStrHashItem;
begin
  P := Find(Key)^;
  
  if P <> nil then
  begin
    Result := True;
    P^.Value := Value;
  end
  else
    Result := False;
end;

procedure TEtIntHashTable.Remove(const Key: Integer);
var
  P: PEtIntHashItem;
  Prev: PPEtIntHashItem;
begin
  Prev := Find(Key);
  if Prev = nil then
    Exit;
    
  P := Prev^;
  if P <> nil then
  begin
    Prev^ := P^.Next;
    Dispose(P);
  end;
  Dec( FCount ); 
  FChanged  := True;
end;

procedure TEtStrHashTable.Remove(const Key: String );
var
  P   : PEtStrHashItem;
  Prev: PPEtStrHashItem;
begin
  Prev := Find(Key);
  if prev = nil then Exit;
  
  P := Prev^;
  if P <> nil then
  begin
    Prev^ := P^.Next;
    Dispose(P);
  end;
  Dec( FCount ); 
  FChanged  := True;
end;

function TEtIntHashTable.ValueOf(const Key: Integer): Pointer;
var
  P: PEtIntHashItem;
begin
  Result  := nil;
  P := Find(Key)^;
  if P <> nil then
    Result := P^.Value;
end;

function TEtStrHashTable.ValueOf(const Key: String): Pointer;
var
  P: PEtStrHashItem;
begin
  Result  := nil;
  P := Find(Key)^;
  if P <> nil then
    Result := P^.Value;
end;

procedure TEtIntHashTable.SetValue(const Key: Integer; Value: Pointer);
begin
  if ValueOf( Key ) = nil then
    Add( Key, Value )
  else
    Modify( Key, Value );
end;

procedure TEtStrHashTable.SetValue(const Key: String; Value: Pointer);
begin
  if ValueOf( Key ) = nil then
    Add( Key, Value )
  else
    Modify( Key, Value );
end;


procedure TEtIntHashTable.DoOnEachItem(_proc: TMethodOnIntHashItem );
var
  I       : Integer;
  Pi, Ni  : PEtIntHashItem;
begin

  for I := 0 to Length(IntBuckets) - 1 do
  begin
    Pi := IntBuckets[I];
    while Pi <> nil do
    begin
      Ni := Pi^.Next;
      _proc( pi^.Key, pi^.Value );
      Pi := Ni;
    end;
  end;

end;

procedure TEtIntHashTable.ProcEachItem(_proc: TProcOnIntHashItem );
var
  I       : Integer;
  Pi, Ni  : PEtIntHashItem;
begin

  for I := 0 to Length(IntBuckets) - 1 do
  begin
    Pi := IntBuckets[I];
    while Pi <> nil do
    begin
      Ni := Pi^.Next;
      _proc( pi^.Key, pi^.Value );
      Pi := Ni;
    end;
  end;

end;
procedure TEtStrHashTable.DoOnEachItem(_proc: TProcOnStrHashItem);
var
  I       : Integer;
  Ps, Ns  : PEtStrHashItem;
begin

  for I := 0 to Length(StrBuckets) - 1 do
  begin
    Ps := StrBuckets[I];
    while Ps <> nil do
    begin
      Ns := Ps^.Next;
      _proc( ps^.Key, ps^.Value );
      Ps := Ns;
    end;
  end;

end;


end.