unit ZMHash19;
(*
ZMHash19.pas - Hash list for entries
Copyright (C) 2009, 2010 by Russell J. Peters, Roger Aelbrecht,
Eric W. Engler and Chris Vleghert.
This file is part of TZipMaster Version 1.9.
TZipMaster is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
TZipMaster 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. See the
GNU Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public License
along with TZipMaster. If not, see <http://www.gnu.org/licenses/>.
contact: problems@delphizip.org (include ZipMaster in the subject).
updates: http://www.delphizip.org
DelphiZip maillist subscribe at http://www.freelists.org/list/delphizip
modified 2009-04-21
---------------------------------------------------------------------------*)
interface
uses
ZipMstr19, ZMIRec19, ZMCore19;
const
HDEBlockEntries = 511; // number of entries per block
type
PHashedDirEntry = ^THashedDirEntry;
THashedDirEntry = record
Next: PHashedDirEntry;
ZRec: TZMIRec;
end;
// for speed and efficiency allocate blocks of entries
PHDEBlock = ^THDEBlock;
THDEBlock = packed record
Entries: array [0..(HDEBlockEntries -1)] of THashedDirEntry;
Next: PHDEBlock;
end;
TZMDirHashList = class(TObject)
private
fLastBlock: PHDEBlock;
fNextEntry: Cardinal;
{$IFNDEF UNICODE}
FWorker: TZMCore;
{$ENDIF}
function GetEmpty: boolean;
function GetSize: Cardinal;
procedure SetEmpty(const Value: boolean);
procedure SetSize(const Value: Cardinal);
protected
Chains: array of PHashedDirEntry;
fBlocks: Integer;
//1 chain of removed nodes
fEmpties: PHashedDirEntry;
procedure DisposeBlocks;
function GetEntry: PHashedDirEntry;
function Same(Entry: PHashedDirEntry; Hash: Cardinal; const Str: String):
Boolean;
public
function Add(const Rec: TZMIRec): TZMIRec;
procedure AfterConstruction; override;
procedure AutoSize(Req: Cardinal);
procedure BeforeDestruction; override;
procedure Clear;
function Find(const FileName: String): TZMIRec;
//1 return true if removed
function Remove(const ZDir: TZMIRec): boolean;
property Empty: boolean read GetEmpty write SetEmpty;
property Size: Cardinal read GetSize write SetSize;
{$IFNDEF UNICODE}
property Worker: TZMCore read FWorker write FWorker;
{$ENDIF}
end;
implementation
uses
SysUtils, Windows, ZMMatch19;
const
ChainsMax = 65537;
ChainsMin = 61;
CapacityMin = 64;
function TZMDirHashList.Add(const Rec: TZMIRec): TZMIRec;
var
Entry: PHashedDirEntry;
Hash: Cardinal;
Idx: Integer;
Parent: PHashedDirEntry;
S: String;
begin
Assert(Rec <> nil, 'nil ZipDirEntry');
if Chains = nil then
Size := 1283;
Result := nil;
S := Rec.FileName;
Hash := Rec.Hash;
Idx := Hash mod Cardinal(Length(Chains));
Entry := Chains[Idx];
if Entry = nil then
begin
Entry := GetEntry;
Entry.ZRec := Rec;
Entry.Next := nil;
Chains[Idx] := Entry;
end
else
begin
repeat
if Same(Entry, Hash, S) then
begin
Result := Entry.ZRec; // duplicate name
exit;
end;
Parent := Entry;
Entry := Entry.Next;
if Entry = nil then
begin
Entry := GetEntry;
Entry.ZRec := nil;
Parent.Next := Entry;
end;
until (Entry.ZRec = nil);
// we have an entry so fill in the details
Entry.ZRec := Rec;
Entry.Next := nil;
end;
end;
procedure TZMDirHashList.AfterConstruction;
begin
inherited;
fBlocks := 0;
fLastBlock := nil;
fEmpties := nil;
fNextEntry := HIGH(Cardinal);
end;
// set size to a reasonable prime number
procedure TZMDirHashList.AutoSize(Req: Cardinal);
const
PrimeSizes: array[0..29] of Cardinal =
(61, 131, 257, 389, 521, 641, 769, 1031, 1283, 1543, 2053, 2579, 3593,
4099, 5147, 6151, 7177, 8209, 10243, 12289, 14341, 16411, 18433, 20483,
22521, 24593, 28687, 32771, 40961, 65537);
var
i: Integer;
begin
if Req < 12000 then
begin
// use next higher size
for i := 0 to HIGH(PrimeSizes) do
if PrimeSizes[i] >= Req then
begin
Req := PrimeSizes[i];
break;
end;
end
else
begin
// use highest smaller size
for i := HIGH(PrimeSizes) downto 0 do
if PrimeSizes[i] < Req then
begin
Req := PrimeSizes[i];
break;
end;
end;
SetSize(Req);
end;
procedure TZMDirHashList.BeforeDestruction;
begin
Clear;
inherited;
end;
procedure TZMDirHashList.Clear;
begin
DisposeBlocks;
Chains := nil; // empty it
end;
procedure TZMDirHashList.DisposeBlocks;
var
TmpBlock: PHDEBlock;
begin
while fLastBlock <> nil do
begin
TmpBlock := fLastBlock;
fLastBlock := TmpBlock^.Next;
Dispose(TmpBlock);
end;
fBlocks := 0;
fLastBlock := nil;
fEmpties := nil;
fNextEntry := HIGH(Cardinal);
end;
function TZMDirHashList.Find(const FileName: String): TZMIRec;
var
Entry: PHashedDirEntry;
Hash: Cardinal;
idx: Cardinal;
begin
Result := nil;
if Chains = nil then
exit;
Hash := HashFunc(FileName);
idx := Hash mod Cardinal(Length(Chains));
Entry := Chains[idx];
// check entries in this chain
while Entry <> nil do
begin
if Same(Entry, Hash, FileName) then
begin
Result := Entry.ZRec;
break;
end
else
Entry := Entry.Next;
end;
end;
function TZMDirHashList.GetEmpty: boolean;
begin
Result := Chains = nil;
end;
// return address in allocated block
function TZMDirHashList.GetEntry: PHashedDirEntry;
var
TmpBlock: PHDEBlock;
begin
if fEmpties <> nil then
begin
Result := fEmpties; // last emptied
fEmpties := fEmpties.Next;
end
else
begin
if (fBlocks < 1) or (fNextEntry >= HDEBlockEntries) then
begin
// we need a new block
New(TmpBlock);
ZeroMemory(TmpBlock, sizeof(THDEBlock));
TmpBlock^.Next := fLastBlock;
fLastBlock := TmpBlock;
Inc(fBlocks);
fNextEntry := 0;
end;
Result := @fLastBlock^.Entries[fNextEntry];
Inc(fNextEntry);
end;
end;
function TZMDirHashList.GetSize: Cardinal;
begin
Result := Length(Chains);
end;
function TZMDirHashList.Remove(const ZDir: TZMIRec): boolean;
var
Entry: PHashedDirEntry;
FileName: String;
Hash: Cardinal;
idx: Cardinal;
Prev: PHashedDirEntry;
begin
Result := false;
if (ZDir = nil) or (Chains = nil) then
exit;
FileName := ZDir.FileName;
Hash := ZDir.Hash;
idx := Hash mod Cardinal(Length(Chains));
Entry := Chains[idx];
Prev := nil;
while Entry <> nil do
begin
if Same(Entry, Hash, FileName) and (Entry.ZRec = ZDir) then
begin
// we found it so unlink it
if Prev = nil then
begin
// first in chain
Chains[idx] := Entry.Next; // link to next
end
else
begin
Prev.Next := Entry.Next; // link to next
end;
Entry.Next := fEmpties; // link to removed
fEmpties := Entry;
Entry.ZRec := nil;
Result := True;
break;
end
else
begin
Prev := Entry;
Entry := Entry.Next;
end;
end;
end;
function TZMDirHashList.Same(Entry: PHashedDirEntry; Hash: Cardinal; const Str:
String): Boolean;
var
IRec: TZMIRec;
begin
IRec := Entry^.ZRec;
Result := (Hash = IRec.Hash) and
{$IFDEF UNICODE}
(FileNameComp(Str, IRec.FileName) = 0);
{$ELSE}
(FileNameComp(Str, IRec.FileName, Worker.UseUTF8) = 0);
{$ENDIF}
end;
procedure TZMDirHashList.SetEmpty(const Value: boolean);
begin
if Value then
Clear;
end;
procedure TZMDirHashList.SetSize(const Value: Cardinal);
var
TableSize: Integer;
begin
Clear;
if Value > 0 then
begin
TableSize := Value;
// keep within reasonable limits
if TableSize < ChainsMin then
TableSize := ChainsMin
else
if TableSize > ChainsMax then
TableSize := ChainsMax;
SetLength(Chains, TableSize);
ZeroMemory(Chains, Size * sizeof(PHashedDirEntry));
end;
end;
end.