改良版TStringList类

王朝delphi·作者佚名 2006-01-09

宽屏版字体: 小|中|大|超大

{-----------------------------------------------------------------------------

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).

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;

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;

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;

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;

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;

{ 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;

{ 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;

{ TmwStringHashList }

constructor TmwStringHashList.Create(aHash: TmwStringHash; aCompare: TmwStringHashCompare);

begin

inherited Create;

fHash:= aHash;

fCompare:= aCompare;

end;

procedure TmwStringHashList.AddString(S: String);

var

HashWord: TmwHashWord;

HashValue: Integer;

HashItems: TmwHashItems;

begin

HashValue:= fHash(S);

if HashEx(S, HashValue) then exit;

if HashValue >= fCapacity then SetCapacity(HashValue);

if Items[HashValue] = nil then

begin

Items[HashValue]:= TmwHashWord.Create(S);

end else

if TObject(Items[HashValue]) is TmwHashItems then

begin

TmwHashItems(Items[HashValue]).AddString(S);

end else

begin

HashWord:= Items[HashValue];

HashItems:= TmwHashItems.Create;

Items[HashValue]:= HashItems;

HashItems.AddString(HashWord.S);

HashWord.Free;

HashItems.AddString(S);

end;

function TmwStringHashList.Hash(S: String): Boolean;

begin

Result:= HashEX(S, fHash(S));

end;

function TmwStringHashList.HashEX(S: String; HashValue: Integer): Boolean;

var

Temp: TObject;

Hashword: TmwHashWord;

HashItems: TmwHashItems;

I: Integer;

begin

Result:= False;

if HashValue < 1 then Exit;

if HashValue > Capacity then Exit;

if Items[HashValue] <> nil then

begin

if TObject(Items[HashValue]) is TmwHashWord then

begin

Result:= fCompare(TmwHashWord(Items[HashValue]).S, S);

end else

begin

HashItems:= Items[HashValue];

if Length(S) > HashItems.Capacity then Exit;

Temp:= HashItems[Length(S)];

if Temp <> nil then

if Temp is TmwHashWord then

begin

Result:= fCompare(TmwHashWord(Temp).S, S);

end else

for I:= 0 to TmwHashStrings(Temp).Count -1 do

begin

HashWord:= TmwHashStrings(Temp)[I];

Result:= fCompare(HashWord.S, S);

if Result then exit;

end;

Initialization

InitTables;

end.