{----------------------------------------------------------------------------- The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.mozilla.org/NPL/NPL-1_1Final.html Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the specific language governing rights and limitations under the License. The Original Code is: mwStringHashList.pas, released December 18, 2000. The Initial Developer of the Original Code is Martin Waldenburg (Martin.Waldenburg@T-Online.de). Portions created by Martin Waldenburg are Copyright (C) 2000 Martin Waldenburg. All Rights Reserved. Contributor(s): ___________________. Last Modified: 18/12/2000 Current Version: 1.1 Notes: This is a very fast Hash list for strings. The TinyHash functions should be in most cases suffizient Known Issues: -----------------------------------------------------------------------------} unit mwStringHashList; interface uses Classes, SysUtils; var mwHashTable: array[#0..#255] of Byte; mwInsensitiveHashTable: array[#0..#255] of Byte; type TmwStringHash = function (const aString: String): Integer; TmwStringHashCompare = function (const Str1: String; const Str2: String): Boolean; TmwHashWord = class S: String; constructor Create(aString: String); end; PHashPointerList = ^THashPointerList; THashPointerList = array[1..1] of Pointer; TmwBaseStringHashList = class(TObject) FList: PHashPointerList; fCapacity: Integer; protected function Get(Index: Integer): Pointer; procedure Put(Index: Integer; Item: Pointer); procedure SetCapacity(NewCapacity: Integer); public destructor Destroy; override; property Capacity: Integer read fCapacity; property Items[Index: Integer]: Pointer read Get write Put; default; end; TmwHashStrings = class(TList) public destructor Destroy; override; procedure AddString(S: String); end; TmwHashItems = class(TmwBaseStringHashList) public procedure AddString(S: String); end; TmwStringHashList = class(TmwBaseStringHashList) private fHash: TmwStringHash; fCompare: TmwStringHashCompare; public constructor Create(aHash: TmwStringHash; aCompare: TmwStringHashCompare); procedure AddString(S: String); function Hash(S: String): Boolean; function HashEX(S: String; HashValue: Integer): Boolean; end; function SimpleHash(const aString: String): Integer; function ISimpleHash(const aString: String): Integer; function TinyHash(const aString: String): Integer; function ITinyHash(const aString: String): Integer; function HashCompare(const Str1: String; const Str2: String): Boolean; function IHashCompare(const Str1: String; const Str2: String): Boolean; implementation procedure InitTables; var I: Char; begin for I:= #0 to #255 do begin mwHashTable[I]:= Ord(I); mwInsensitiveHashTable[I]:= Ord(UpperCase(String(I))[1]); end; end; function SimpleHash(const aString: String): Integer; var I: Integer; begin Result:= Length(aString); for I:= 1 to Length(aString) do inc(Result, mwHashTable[aString[I]]); end; function ISimpleHash(const aString: String): Integer; var I: Integer; begin Result:= Length(aString); for I:= 1 to Length(aString) do inc(Result, mwInsensitiveHashTable[aString[I]]); end; function TinyHash(const aString: String): Integer; var I: Integer; begin Result:= Length(aString); for I:= 1 to Length(aString) do begin inc(Result, mwHashTable[aString[I]]); if I = 2 then Break; end; end; function ITinyHash(const aString: String): Integer; var I: Integer; begin Result:= Length(aString); for I:= 1 to Length(aString) do begin inc(Result, mwInsensitiveHashTable[aString[I]]); if I = 2 then Break; end; end; function HashCompare(const Str1: String; const Str2: String): Boolean; var I: Integer; begin if Length(Str1) <> Length(Str2) then begin Result:= False; Exit; end; Result:= True; for I:= 1 to Length(Str1) do if Str1[I] <> Str2[I] then begin Result:= False; Exit; end; end; function IHashCompare(const Str1: String; const Str2: String): Boolean; var I: Integer; begin if Length(Str1) <> Length(Str2) then begin Result:= False; Exit; end; Result:= True; for I:= 1 to Length(Str1) do if mwInsensitiveHashTable[Str1[I]] <> mwInsensitiveHashTable[Str2[I]] then begin Result:= False; Exit; end; end; { TmwHashString } constructor TmwHashWord.Create(aString: String); begin inherited Create; S:= aString; end; { TmwBaseStringHashList } destructor TmwBaseStringHashList.Destroy; var I: Integer; begin for I:= 1 to fCapacity do if Items[I] <> nil then TObject(Items[I]).Free; ReallocMem(FList, 0); inherited Destroy; end; function TmwBaseStringHashList.Get(Index: Integer): Pointer; begin Result:= nil; if (Index > 0) and (Index <= fCapacity) then Result:= fList[Index]; end; procedure TmwBaseStringHashList.Put(Index: Integer; Item: Pointer); begin if (Index > 0) and (Index <= fCapacity) then fList[Index]:= Item; end; procedure TmwBaseStringHashList.SetCapacity(NewCapacity: Integer); var I, OldCapacity: Integer; begin if NewCapacity > fCapacity then begin ReallocMem(FList, (NewCapacity) * SizeOf(Pointer)); OldCapacity:= fCapacity; FCapacity := NewCapacity; for I:= OldCapacity+1 to NewCapacity do Items[I]:= nil; end; end; { TmwHashStrings } procedure TmwHashStrings.AddString(S: String); begin Add(TmwHashWord.Create(S)); end; destructor TmwHashStrings.Destroy; var I: Integer; begin for I:= 0 to Count - 1 do if Items[I] <> nil then TObject(Items[I]).Free; inherited Destroy; end; { TmwHashItems } procedure TmwHashItems.AddString(S: String); var HashWord: TmwHashWord; HashStrings: TmwHashStrings; begin SetCapacity(Length(S)); if Items[Length(S)] = nil then begin Items[Length(S)]:= TmwHashWord.Create(S); end else if TObject(Items[Length(S)]) is TmwHashStrings then begin TmwHashStrings(Items[Length(S)]).AddString(S); end else begin HashWord:= Items[Length(S)]; HashStrings:= TmwHashStrings.Create; Items[Length(S)]:= HashStrings; HashStrings.AddString(HashWord.S); HashWord.Free; HashStrings.AddString(S) end; end; { TmwStringHashList } constructor TmwStringHashList.Create(aHash: TmwStringHash; aCompare: TmwStringHashCompare); begin inherited Create; fHash:= aHash; & [1] [2] 下一页 没有相关教程
|