tpsystools_4.04/source/StDict.pas

// Upgraded to Delphi 2009: Sebastian Zierer

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * 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/MPL/
 *
 * 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 TurboPower SysTools
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1996-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{*********************************************************}
{* SysTools: StDict.pas 4.04                             *}
{*********************************************************}
{* SysTools: Dictionary class                            *}
{*********************************************************}

{$I StDefine.inc}

{Notes:
  Nodes stored in the dictionary must be of type TStDictNode.

  Duplicate strings are not allowed in the dictionary.

  Calling Exists moves the found node to the front of its hash bin list.

  Iterate scans the nodes in hash order.

  Hashing and comparison is case-insensitive by default.

  In 16-bit mode, HashSize must be in the range 1..16380. In 32-bit
  mode, there is no practical limit on HashSize. A particular value
  of HashSize may lead to a better distribution of symbols in the
  dictionary, and therefore to better performance. Generally HashSize
  should be about the same size as the number of symbols expected in
  the dictionary. A prime number tends to give a better distribution.
  Based on analysis by D. Knuth, the following values are good
  choices for HashSize when the dictionary keys are alphanumeric
  strings:

    59 61 67 71 73 127 131 137 191 193 197 199 251 257 263 311 313
   317 379 383 389 439 443 449 457 503 509 521 569 571 577 631 641
   643 647 701 709 761 769 773 823 827 829 839 887 953 967

  Good values for larger tables can be computed by the GOODHASH.PAS
  bonus program.
}

unit StDict;

interface

uses
  Windows, SysUtils, Classes,
  StConst, StBase;

type
  TStDictNode = class(TStNode)
{.Z+}
    protected
      dnNext : TStDictNode;     {Next node in hash list}
      dnName : string;          {Name of symbol, already a pointer}
      function GetName : string;

{.Z-}
    public
      constructor CreateStr(const Name : string; AData : Pointer);
        {-Initialize node}
      destructor Destroy; override;
        {-Free name string and destroy node}

      property Name : string
         read GetName;
  end;

{.Z+}
  TSymbolArray = array[0..(StMaxBlockSize div SizeOf(TStDictNode))-1] of TStDictNode;
  PSymbolArray = ^TSymbolArray;
{.Z-}

  TDictHashFunc =
    function(const S : AnsiString; Size : Integer) : Integer;

  TStDictionary = class(TStContainer)
{.Z+}
  protected
    {property instance variables}
    FHashSize : Integer;            {Bins in symbol array}
    FEqual    : TStringCompareFunc; {String compare function}
    FHash     : TDictHashFunc;

    {event variables}
    FOnEqual  : TStStringCompareEvent;

    {private instance variables}
    dySymbols : PSymbolArray;     {Pointer to symbol array}
    dyIgnoreDups : Boolean;       {Ignore duplicates during Join?}

    {protected undocumented methods}
    procedure dySetEqual(E : TStringCompareFunc);
    procedure dySetHash(H : TDictHashFunc);
    procedure dySetHashSize(Size : Integer);
    procedure dyFindNode(const Name : string; var H : Integer;
                         var Prev, This : TStDictNode);
{.Z-}
  public
    constructor Create(AHashSize : Integer); virtual;
      {-Initialize an empty dictionary}
    destructor Destroy; override;
      {-Destroy a dictionary}

    procedure LoadFromStream(S : TStream); override;
      {-Read a dictionary and its data from a stream}
    procedure StoreToStream(S : TStream); override;
      {-Write a dictionary and its data to a stream}

    procedure Clear; override;
      {-Remove all nodes from container but leave it instantiated}
    function DoEqual(const String1, String2 : string) : Integer;
      virtual;
    function Exists(const Name : string; var Data : Pointer) : Boolean;
      {-Return True and the Data pointer if Name is in the dictionary}
    procedure Add(const Name : string; Data : Pointer);
      {-Add new Name and Data to the dictionary}
    procedure Delete(const Name : string);
      {-Delete a Name from the dictionary}
    procedure GetItems(S : TStrings);
      {-Fill the string list with all stored strings}
    procedure SetItems(S : TStrings);
      {-Fill the container with the strings and objects in S}
    procedure Update(const Name : string; Data : Pointer);
      {-Update the data for an existing element}
    function Find(Data : Pointer; var Name : string) : Boolean;
      {-Return True and the element Name that matches Data}

    procedure Assign(Source: TPersistent); override;
      {-Assign another container's contents to this one}
    procedure Join(D : TStDictionary; IgnoreDups : Boolean);
      {-Add dictionary D into this one and dispose D}

    function Iterate(Action : TIterateFunc;
                     OtherData : Pointer) : TStDictNode;
      {-Call Action for all the nodes, returning the last node visited}

    function BinCount(H : Integer) : LongInt;
      {-Return number of names in a hash bin (for testing)}

    property Equal : TStringCompareFunc
      read FEqual
      write dySetEqual;

    property Hash : TDictHashFunc
      read FHash
      write dySetHash;

    property HashSize : Integer
      read FHashSize
      write dySetHashSize;

    property OnEqual : TStStringCompareEvent
      read FOnEqual
      write FOnEqual;
  end;


function AnsiHashText(const S : AnsiString; Size : Integer) : Integer;
  {-Case-insensitive hash function that uses the current language driver}
function AnsiHashStr(const S : AnsiString; Size : Integer) : Integer;
  {-Case-sensitive hash function}
function AnsiELFHashText(const S : AnsiString; Size : Integer) : Integer;
  {-Case-insensitive ELF hash function that uses the current language driver}
function AnsiELFHashStr(const S : AnsiString; Size : Integer) : Integer;
  {-Case-sensitive ELF hash function}


implementation

{$IFDEF UNICODE}
uses
  AnsiStrings;
{$ENDIF}

{$IFDEF ThreadSafe}
var
  ClassCritSect : TRTLCriticalSection;
{$ENDIF}

procedure EnterClassCS;
begin
{$IFDEF ThreadSafe}
  EnterCriticalSection(ClassCritSect);
{$ENDIF}
end;

procedure LeaveClassCS;
begin
{$IFDEF ThreadSafe}
  LeaveCriticalSection(ClassCritSect);
{$ENDIF}
end;


{The following routine was extracted from LockBox and modified}
function HashElf(const Buf;  BufSize : LongInt) : LongInt;
var
//  Bytes : TByteArray absolute Buf;                                   {!!.02}
  Bytes : PAnsiChar;                                                       {!!.02}
  I, X  : LongInt;
begin
  Bytes := @Buf;                                                       {!!.02}
  Result := 0;
  for I := 0 to BufSize - 1 do begin
    Result := (Result shl 4) + Ord(Bytes^);                            {!!.02}
    Inc(Bytes);                                                        {!!.02}
    X := LongInt(Result and $F0000000);                                {!!.02}
    if (X <> 0) then
      Result := Result xor (X shr 24);
    Result := Result and (not X);
  end;
end;

function AnsiELFHashText(const S : AnsiString; Size : Integer) : Integer;
begin
  {$IFDEF WStrings}
  Result := AnsiELFHashStr(AnsiUpperCaseShort32(S), Size);
  {$ELSE}
  Result := AnsiELFHashStr(AnsiUpperCase(S), Size);
  {$ENDIF}
end;

function AnsiELFHashStr(const S : AnsiString; Size : Integer) : Integer;
begin
  Result := HashElf(S[1], Length(S)) mod Size;
  if Result < 0 then
    Inc(Result, Size);
end;

constructor TStDictNode.CreateStr(const Name : string; AData : Pointer);
begin
  Create(AData);
  dnName := Name;
end;

destructor TStDictNode.Destroy;
begin
  dnName := '';
  inherited Destroy;
end;

function TStDictNode.GetName : string;
begin
  Result := dnName;
end;

function AnsiHashStr(const S : AnsiString; Size : Integer) : Integer;
  {32-bit huge string}
register;
asm
  push ebx
  push esi
  push edi
  mov esi,S
  mov edi,Size
  xor ebx,ebx      {ebx will be hash}
  or esi,esi       {empty literal string comes in as a nil pointer}
  jz @2
  mov edx,[esi-4]  {edx = length}
  or edx,edx       {length zero?}
  jz @2
  xor ecx,ecx      {ecx is shift counter}
@1:xor eax,eax
  mov al,[esi]     {eax = character}
  inc esi
  rol eax,cl       {rotate character}
  xor ebx,eax      {xor with hash}
  inc ecx          {increment shift counter (rol uses only bottom 5 bits)}
  dec edx
  jnz @1
@2:mov eax,ebx
  xor edx,edx
  div edi          {edi = Size}
  mov eax,edx      {return hash mod size}
  pop edi
  pop esi
  pop ebx
end;

function AnsiHashText(const S : AnsiString; Size : Integer) : Integer;
begin
{$IFDEF WStrings}
  Result := AnsiHashStr(AnsiUpperCaseShort32(S), Size);
{$ELSE}
  Result := AnsiHashStr(AnsiUpperCase(S), Size);
{$ENDIF}
end;

function FindNodeData(Container : TStContainer;
                      Node : TStNode;
                      OtherData : Pointer) : Boolean; far;
begin
  Result := (OtherData <> Node.Data);
end;

function JoinNode(Container : TStContainer;
                  Node : TStNode;
                  OtherData : Pointer) : Boolean; far;
var
  H : Integer;
  P, T : TStDictNode;
begin
  Result := True;
  with TStDictionary(OtherData) do begin
    dyFindNode(TStDictNode(Node).dnName, H, P, T);
    if Assigned(T) then
      if dyIgnoreDups then begin
        Node.Free;
        Exit;
      end else
        RaiseContainerError(stscDupNode);
    T := dySymbols^[H];
    dySymbols^[H] := TStDictNode(Node);
    dySymbols^[H].dnNext := T;
    Inc(FCount);
  end;
end;

function AssignNode(Container : TStContainer;
                    Node : TStNode;
                    OtherData : Pointer) : Boolean; far;
  var
    DictNode : TStDictNode absolute Node;
    OurDict : TStDictionary absolute OtherData;
  begin
    OurDict.Add(DictNode.Name, DictNode.Data);
    Result := true;
  end;

{----------------------------------------------------------------------}

procedure TStDictionary.Add(const Name : string; Data : Pointer);
var
  H : Integer;
  P, T : TStDictNode;
begin
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
    dyFindNode(Name, H, P, T);
    if Assigned(T) then
      RaiseContainerError(stscDupNode);
    T := dySymbols^[H];
    dySymbols^[H] := TStDictNode.CreateStr(Name, Data);
    dySymbols^[H].dnNext := T;
    Inc(FCount);
{$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;
{$ENDIF}
end;

procedure TStDictionary.Assign(Source: TPersistent);
  var
    i : integer;
  begin
    {The only two containers that we allow to be assigned to a string
     dictionary are (1) another string dictionary and (2) a Delphi string
     list (TStrings)}
    if (Source is TStDictionary) then
      begin
        Clear;
        TStDictionary(Source).Iterate(AssignNode, Self);
      end
    else if (Source is TStrings) then
      begin
        Clear;
        for i := 0 to pred(TStrings(Source).Count) do
          Add(TStrings(Source).Strings[i], TStrings(Source).Objects[i]);
      end
    else
      inherited Assign(Source);
  end;

function TStDictionary.BinCount(H : Integer) : LongInt;
var
  C : LongInt;
  T : TStDictNode;
begin
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
    C := 0;
    T := dySymbols^[H];
    while Assigned(T) do begin
      inc(C);
      T := T.dnNext;
    end;
    Result := C;
{$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;
{$ENDIF}
end;

procedure TStDictionary.Clear;
begin
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
    if FCount <> 0 then begin
      Iterate(DestroyNode, nil);
      FCount := 0;
      FillChar(dySymbols^, LongInt(FHashSize)*SizeOf(TStDictNode), 0);
    end;
{$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;
{$ENDIF}
end;

constructor TStDictionary.Create(AHashSize : Integer);
begin
  CreateContainer(TStDictNode, 0);
  {FHashSize := 0;}
{$IFDEF WStrings}
  FEqual := AnsiCompareTextShort32;
{$ELSE}
  FEqual := AnsiCompareText;
{$ENDIF}
  FHash := AnsiHashText;
  HashSize := AHashSize;
end;

procedure TStDictionary.Delete(const Name : string);
var
  H : Integer;
  P, T : TStDictNode;
begin
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
    dyFindNode(Name, H, P, T);
    if Assigned(T) then begin
      if Assigned(P) then
        P.dnNext := T.dnNext
      else
        dySymbols^[H] := T.dnNext;
      DestroyNode(Self, T, nil);
      Dec(FCount);
    end;
{$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;
{$ENDIF}
end;

destructor TStDictionary.Destroy;
begin
  if conNodeProt = 0 then
    Clear;
  if Assigned(dySymbols) then
    FreeMem(dySymbols, LongInt(FHashSize)*SizeOf(TStDictNode));
  IncNodeProtection;
  inherited Destroy;
end;

function TStDictionary.DoEqual(const String1, String2 : string) : Integer;
begin
  Result := 0;
  if Assigned(FOnEqual) then
    FOnEqual(Self, String1, String2, Result)
  else if Assigned(FEqual) then
    Result := FEqual(String1, String2);
end;

procedure TStDictionary.dyFindNode(const Name : string; var H : Integer;
                                   var Prev, This : TStDictNode);
var
  P, T : TStDictNode;
begin
  Prev := nil;
  This := nil;
  H := Hash(Name, HashSize);
  T := dySymbols^[H];
  P := nil;
  while Assigned(T) do begin
    if DoEqual(Name, T.dnName) = 0 then begin
      Prev := P;
      This := T;
      Exit;
    end;
    P := T;
    T := T.dnNext;
  end;

  {Not found}
  This := nil;
end;

procedure TStDictionary.dySetEqual(E : TStringCompareFunc);
begin
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
    if Count = 0 then
      FEqual := E;
{$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;
{$ENDIF}
end;

procedure TStDictionary.dySetHash(H : TDictHashFunc);
begin
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
    if Count = 0 then
      FHash := H;
{$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;
{$ENDIF}
end;

procedure TStDictionary.dySetHashSize(Size : Integer);
var
  H, OldSize :  Integer;
  TableSize : LongInt;
  T, N : TStDictNode;
  OldSymbols : PSymbolArray;
  OldDisposeData : TDisposeDataProc;
  OldOnDisposeData : TStDisposeDataEvent;
begin
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
    TableSize := LongInt(Size)*SizeOf(TStDictNode);
    if (Size <= 0) {or (TableSize > MaxBlockSize)} then
      RaiseContainerError(stscBadSize);

    if Size <> FHashSize then begin
      OldSymbols := dySymbols;
      OldSize := FHashSize;

      {Get a new hash table}
      GetMem(dySymbols, TableSize);
      FillChar(dySymbols^, TableSize, 0);
      FCount := 0;
      FHashSize := Size;

      if OldSize <> 0 then begin
        {Prevent disposing of the user data while transferring elements}
        OldDisposeData := DisposeData;
        DisposeData := nil;
        OldOnDisposeData := OnDisposeData;
        OnDisposeData := nil;
        {Add old symbols into new hash table}
        for H := 0 to OldSize-1 do begin
          T := OldSymbols^[H];
          while Assigned(T) do begin
            Add(T.dnName, T.Data);
            N := T.dnNext;
            {free the node just transferred}
            T.Free;
            T := N;
          end;
        end;
        {Dispose of old hash table}
        FreeMem(OldSymbols, OldSize*SizeOf(TStDictNode));
        {Reassign the dispose data routine}
        DisposeData := OldDisposeData;
        OnDisposeData := OldOnDisposeData;
      end;

      {FHashSize := Size;}
    end;
{$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;
{$ENDIF}
end;

function TStDictionary.Exists(const Name : String; var Data : Pointer) : Boolean;
var
  H : Integer;
  P, T : TStDictNode;
begin
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
    dyFindNode(Name, H, P, T);
    if Assigned(T) then begin
      if Assigned(P) then begin
        {Move T to front of list}
        P.dnNext := T.dnNext;
        T.dnNext := dySymbols^[H];
        dySymbols^[H] := T;
      end;
      Result := True;
      Data := T.Data;
    end else
      Result := False;
{$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;
{$ENDIF}
end;

function TStDictionary.Find(Data : Pointer; var Name : string) : Boolean;
var
  T : TStDictNode;
begin
  Name := '';
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
    T := Iterate(FindNodeData, Data);
    if Assigned(T) then begin
      Result := True;
      Name := T.dnName;
    end else
      Result := False;
{$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;
{$ENDIF}
end;

procedure TStDictionary.GetItems(S : TStrings);
var
  H : Integer;
  T : TStDictNode;
begin
  S.Clear;
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
    if FCount <> 0 then begin
      for H := 0 to FHashSize-1 do begin
        T := dySymbols^[H];
        while Assigned(T) do begin
          S.AddObject(T.Name, T.Data);
          T := T.dnNext;
        end;
      end;
    end;
{$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;
{$ENDIF}
end;

procedure TStDictionary.SetItems(S : TStrings);
var
  I : Integer;
begin
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
    Clear;
    for I := 0 to S.Count-1 do
      Add(S.Strings[I], S.Objects[I]);
{$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;
{$ENDIF}
end;

function TStDictionary.Iterate(Action : TIterateFunc;
                               OtherData : Pointer) : TStDictNode;
var
  H    : Integer;
  T, N : TStDictNode;
begin
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
    if FCount <> 0 then begin
      for H := 0 to FHashSize-1 do begin
        T := dySymbols^[H];
        while Assigned(T) do begin
          N := T.dnNext;
          if Action(Self, T, OtherData) then
            T := N
          else begin
            Result := T;
            Exit;
          end;
        end;
      end;
    end;
    Result := nil;
{$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;
{$ENDIF}
end;

procedure TStDictionary.Join(D : TStDictionary; IgnoreDups : Boolean);
begin
{$IFDEF ThreadSafe}
  EnterClassCS;
  EnterCS;
  D.EnterCS;
  try
{$ENDIF}
    dyIgnoreDups := IgnoreDups;
    D.Iterate(JoinNode, Self);

    {Dispose of D, but not its nodes}
    D.IncNodeProtection;
    D.Free;
{$IFDEF ThreadSafe}
  finally
    D.LeaveCS;
    LeaveCS;
    LeaveClassCS;
  end;
{$ENDIF}
end;

procedure TStDictionary.Update(const Name : string; Data : Pointer);
var
  H : Integer;
  P, T : TStDictNode;
begin
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
    dyFindNode(Name, H, P, T);
    if Assigned(T) then
      T.Data := Data;
{$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;
{$ENDIF}
end;

procedure TStDictionary.LoadFromStream(S : TStream);
var
  Data : pointer;
  Reader : TReader;
  StreamedClass : TPersistentClass;
  StreamedNodeClass : TPersistentClass;
  StreamedClassName : string;
  StreamedNodeClassName : string;
  St : string;
begin
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
    Clear;
    Reader := TReader.Create(S, 1024);
    try
      with Reader do
        begin
          StreamedClassName := ReadString;
          StreamedClass := GetClass(StreamedClassName);
          if (StreamedClass = nil) then
            RaiseContainerErrorFmt(stscUnknownClass, [StreamedClassName]);
          if (StreamedClass <> Self.ClassType) then
            RaiseContainerError(stscWrongClass);
          StreamedNodeClassName := ReadString;
          StreamedNodeClass := GetClass(StreamedNodeClassName);
          if (StreamedNodeClass = nil) then
            RaiseContainerErrorFmt(stscUnknownNodeClass, [StreamedNodeClassName]);
          if (StreamedNodeClass <> conNodeClass) then
            RaiseContainerError(stscWrongNodeClass);
          HashSize := ReadInteger;
          ReadListBegin;
          while not EndOfList do
            begin
              St := ReadString;
              Data := DoLoadData(Reader);
              Add(St, Data);
            end;
          ReadListEnd;
        end;
    finally
      Reader.Free;
    end;
{$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;
{$ENDIF}
end;

procedure TStDictionary.StoreToStream(S : TStream);
var
  H      : Integer;
  Walker : TStDictNode;
  Writer : TWriter;
begin
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
    Writer := TWriter.Create(S, 1024);
    try
      with Writer do
        begin
          WriteString(Self.ClassName);
          WriteString(conNodeClass.ClassName);
          WriteInteger(HashSize);
          WriteListBegin;
          if (Count <> 0) then
            for H := 0 to FHashSize-1 do
              begin
                Walker := dySymbols^[H];
                while Assigned(Walker) do
                  begin
                    WriteString(Walker.dnName);
                    DoStoreData(Writer, Walker.Data);
                    Walker := Walker.dnNext;
                  end;
              end;
          WriteListEnd;
        end;
    finally
      Writer.Free;
    end;
{$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;
{$ENDIF}
end;

{$IFDEF ThreadSafe}
initialization
  Windows.InitializeCriticalSection(ClassCritSect);
finalization
  Windows.DeleteCriticalSection(ClassCritSect);
{$ENDIF}
end.
1	// Upgraded to Delphi 2009: Sebastian Zierer
2
3	(* *** BEGIN LICENSE BLOCK ***
4	* Version: MPL 1.1
5	*
6	* The contents of this file are subject to the Mozilla Public License Version
7	* 1.1 (the "License"); you may not use this file except in compliance with
8	* the License. You may obtain a copy of the License at
9	* http://www.mozilla.org/MPL/
10	*
11	* Software distributed under the License is distributed on an "AS IS" basis,
12	* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
13	* for the specific language governing rights and limitations under the
14	* License.
15	*
16	* The Original Code is TurboPower SysTools
17	*
18	* The Initial Developer of the Original Code is
19	* TurboPower Software
20	*
21	* Portions created by the Initial Developer are Copyright (C) 1996-2002
22	* the Initial Developer. All Rights Reserved.
23	*
24	* Contributor(s):
25	*
26	* *** END LICENSE BLOCK *** *)
27
28	{*********************************************************}
29	{* SysTools: StDict.pas 4.04 *}
30	{*********************************************************}
31	{* SysTools: Dictionary class *}
32	{*********************************************************}
33
34	{$I StDefine.inc}
35
36	{Notes:
37	Nodes stored in the dictionary must be of type TStDictNode.
38
39	Duplicate strings are not allowed in the dictionary.
40
41	Calling Exists moves the found node to the front of its hash bin list.
42
43	Iterate scans the nodes in hash order.
44
45	Hashing and comparison is case-insensitive by default.
46
47	In 16-bit mode, HashSize must be in the range 1..16380. In 32-bit
48	mode, there is no practical limit on HashSize. A particular value
49	of HashSize may lead to a better distribution of symbols in the
50	dictionary, and therefore to better performance. Generally HashSize
51	should be about the same size as the number of symbols expected in
52	the dictionary. A prime number tends to give a better distribution.
53	Based on analysis by D. Knuth, the following values are good
54	choices for HashSize when the dictionary keys are alphanumeric
55	strings:
56
57	59 61 67 71 73 127 131 137 191 193 197 199 251 257 263 311 313
58	317 379 383 389 439 443 449 457 503 509 521 569 571 577 631 641
59	643 647 701 709 761 769 773 823 827 829 839 887 953 967
60
61	Good values for larger tables can be computed by the GOODHASH.PAS
62	bonus program.
63	}
64
65	unit StDict;
66
67	interface
68
69	uses
70	Windows, SysUtils, Classes,
71	StConst, StBase;
72
73	type
74	TStDictNode = class(TStNode)
75	{.Z+}
76	protected
77	dnNext : TStDictNode; {Next node in hash list}
78	dnName : string; {Name of symbol, already a pointer}
79	function GetName : string;
80
81	{.Z-}
82	public
83	constructor CreateStr(const Name : string; AData : Pointer);
84	{-Initialize node}
85	destructor Destroy; override;
86	{-Free name string and destroy node}
87
88	property Name : string
89	read GetName;
90	end;
91
92	{.Z+}
93	TSymbolArray = array[0..(StMaxBlockSize div SizeOf(TStDictNode))-1] of TStDictNode;
94	PSymbolArray = ^TSymbolArray;
95	{.Z-}
96
97	TDictHashFunc =
98	function(const S : AnsiString; Size : Integer) : Integer;
99
100	TStDictionary = class(TStContainer)
101	{.Z+}
102	protected
103	{property instance variables}
104	FHashSize : Integer; {Bins in symbol array}
105	FEqual : TStringCompareFunc; {String compare function}
106	FHash : TDictHashFunc;
107
108	{event variables}
109	FOnEqual : TStStringCompareEvent;
110
111	{private instance variables}
112	dySymbols : PSymbolArray; {Pointer to symbol array}
113	dyIgnoreDups : Boolean; {Ignore duplicates during Join?}
114
115	{protected undocumented methods}
116	procedure dySetEqual(E : TStringCompareFunc);
117	procedure dySetHash(H : TDictHashFunc);
118	procedure dySetHashSize(Size : Integer);
119	procedure dyFindNode(const Name : string; var H : Integer;
120	var Prev, This : TStDictNode);
121	{.Z-}
122	public
123	constructor Create(AHashSize : Integer); virtual;
124	{-Initialize an empty dictionary}
125	destructor Destroy; override;
126	{-Destroy a dictionary}
127
128	procedure LoadFromStream(S : TStream); override;
129	{-Read a dictionary and its data from a stream}
130	procedure StoreToStream(S : TStream); override;
131	{-Write a dictionary and its data to a stream}
132
133	procedure Clear; override;
134	{-Remove all nodes from container but leave it instantiated}
135	function DoEqual(const String1, String2 : string) : Integer;
136	virtual;
137	function Exists(const Name : string; var Data : Pointer) : Boolean;
138	{-Return True and the Data pointer if Name is in the dictionary}
139	procedure Add(const Name : string; Data : Pointer);
140	{-Add new Name and Data to the dictionary}
141	procedure Delete(const Name : string);
142	{-Delete a Name from the dictionary}
143	procedure GetItems(S : TStrings);
144	{-Fill the string list with all stored strings}
145	procedure SetItems(S : TStrings);
146	{-Fill the container with the strings and objects in S}
147	procedure Update(const Name : string; Data : Pointer);
148	{-Update the data for an existing element}
149	function Find(Data : Pointer; var Name : string) : Boolean;
150	{-Return True and the element Name that matches Data}
151
152	procedure Assign(Source: TPersistent); override;
153	{-Assign another container's contents to this one}
154	procedure Join(D : TStDictionary; IgnoreDups : Boolean);
155	{-Add dictionary D into this one and dispose D}
156
157	function Iterate(Action : TIterateFunc;
158	OtherData : Pointer) : TStDictNode;
159	{-Call Action for all the nodes, returning the last node visited}
160
161	function BinCount(H : Integer) : LongInt;
162	{-Return number of names in a hash bin (for testing)}
163
164	property Equal : TStringCompareFunc
165	read FEqual
166	write dySetEqual;
167
168	property Hash : TDictHashFunc
169	read FHash
170	write dySetHash;
171
172	property HashSize : Integer
173	read FHashSize
174	write dySetHashSize;
175
176	property OnEqual : TStStringCompareEvent
177	read FOnEqual
178	write FOnEqual;
179	end;
180
181
182	function AnsiHashText(const S : AnsiString; Size : Integer) : Integer;
183	{-Case-insensitive hash function that uses the current language driver}
184	function AnsiHashStr(const S : AnsiString; Size : Integer) : Integer;
185	{-Case-sensitive hash function}
186	function AnsiELFHashText(const S : AnsiString; Size : Integer) : Integer;
187	{-Case-insensitive ELF hash function that uses the current language driver}
188	function AnsiELFHashStr(const S : AnsiString; Size : Integer) : Integer;
189	{-Case-sensitive ELF hash function}
190
191
192	implementation
193
194	{$IFDEF UNICODE}
195	uses
196	AnsiStrings;
197	{$ENDIF}
198
199	{$IFDEF ThreadSafe}
200	var
201	ClassCritSect : TRTLCriticalSection;
202	{$ENDIF}
203
204	procedure EnterClassCS;
205	begin
206	{$IFDEF ThreadSafe}
207	EnterCriticalSection(ClassCritSect);
208	{$ENDIF}
209	end;
210
211	procedure LeaveClassCS;
212	begin
213	{$IFDEF ThreadSafe}
214	LeaveCriticalSection(ClassCritSect);
215	{$ENDIF}
216	end;
217
218
219	{The following routine was extracted from LockBox and modified}
220	function HashElf(const Buf; BufSize : LongInt) : LongInt;
221	var
222	// Bytes : TByteArray absolute Buf; {!!.02}
223	Bytes : PAnsiChar; {!!.02}
224	I, X : LongInt;
225	begin
226	Bytes := @Buf; {!!.02}
227	Result := 0;
228	for I := 0 to BufSize - 1 do begin
229	Result := (Result shl 4) + Ord(Bytes^); {!!.02}
230	Inc(Bytes); {!!.02}
231	X := LongInt(Result and $F0000000); {!!.02}
232	if (X <> 0) then
233	Result := Result xor (X shr 24);
234	Result := Result and (not X);
235	end;
236	end;
237
238	function AnsiELFHashText(const S : AnsiString; Size : Integer) : Integer;
239	begin
240	{$IFDEF WStrings}
241	Result := AnsiELFHashStr(AnsiUpperCaseShort32(S), Size);
242	{$ELSE}
243	Result := AnsiELFHashStr(AnsiUpperCase(S), Size);
244	{$ENDIF}
245	end;
246
247	function AnsiELFHashStr(const S : AnsiString; Size : Integer) : Integer;
248	begin
249	Result := HashElf(S[1], Length(S)) mod Size;
250	if Result < 0 then
251	Inc(Result, Size);
252	end;
253
254	constructor TStDictNode.CreateStr(const Name : string; AData : Pointer);
255	begin
256	Create(AData);
257	dnName := Name;
258	end;
259
260	destructor TStDictNode.Destroy;
261	begin
262	dnName := '';
263	inherited Destroy;
264	end;
265
266	function TStDictNode.GetName : string;
267	begin
268	Result := dnName;
269	end;
270
271	function AnsiHashStr(const S : AnsiString; Size : Integer) : Integer;
272	{32-bit huge string}
273	register;
274	asm
275	push ebx
276	push esi
277	push edi
278	mov esi,S
279	mov edi,Size
280	xor ebx,ebx {ebx will be hash}
281	or esi,esi {empty literal string comes in as a nil pointer}
282	jz @2
283	mov edx,[esi-4] {edx = length}
284	or edx,edx {length zero?}
285	jz @2
286	xor ecx,ecx {ecx is shift counter}
287	@1:xor eax,eax
288	mov al,[esi] {eax = character}
289	inc esi
290	rol eax,cl {rotate character}
291	xor ebx,eax {xor with hash}
292	inc ecx {increment shift counter (rol uses only bottom 5 bits)}
293	dec edx
294	jnz @1
295	@2:mov eax,ebx
296	xor edx,edx
297	div edi {edi = Size}
298	mov eax,edx {return hash mod size}
299	pop edi
300	pop esi
301	pop ebx
302	end;
303
304	function AnsiHashText(const S : AnsiString; Size : Integer) : Integer;
305	begin
306	{$IFDEF WStrings}
307	Result := AnsiHashStr(AnsiUpperCaseShort32(S), Size);
308	{$ELSE}
309	Result := AnsiHashStr(AnsiUpperCase(S), Size);
310	{$ENDIF}
311	end;
312
313	function FindNodeData(Container : TStContainer;
314	Node : TStNode;
315	OtherData : Pointer) : Boolean; far;
316	begin
317	Result := (OtherData <> Node.Data);
318	end;
319
320	function JoinNode(Container : TStContainer;
321	Node : TStNode;
322	OtherData : Pointer) : Boolean; far;
323	var
324	H : Integer;
325	P, T : TStDictNode;
326	begin
327	Result := True;
328	with TStDictionary(OtherData) do begin
329	dyFindNode(TStDictNode(Node).dnName, H, P, T);
330	if Assigned(T) then
331	if dyIgnoreDups then begin
332	Node.Free;
333	Exit;
334	end else
335	RaiseContainerError(stscDupNode);
336	T := dySymbols^[H];
337	dySymbols^[H] := TStDictNode(Node);
338	dySymbols^[H].dnNext := T;
339	Inc(FCount);
340	end;
341	end;
342
343	function AssignNode(Container : TStContainer;
344	Node : TStNode;
345	OtherData : Pointer) : Boolean; far;
346	var
347	DictNode : TStDictNode absolute Node;
348	OurDict : TStDictionary absolute OtherData;
349	begin
350	OurDict.Add(DictNode.Name, DictNode.Data);
351	Result := true;
352	end;
353
354	{----------------------------------------------------------------------}
355
356	procedure TStDictionary.Add(const Name : string; Data : Pointer);
357	var
358	H : Integer;
359	P, T : TStDictNode;
360	begin
361	{$IFDEF ThreadSafe}
362	EnterCS;
363	try
364	{$ENDIF}
365	dyFindNode(Name, H, P, T);
366	if Assigned(T) then
367	RaiseContainerError(stscDupNode);
368	T := dySymbols^[H];
369	dySymbols^[H] := TStDictNode.CreateStr(Name, Data);
370	dySymbols^[H].dnNext := T;
371	Inc(FCount);
372	{$IFDEF ThreadSafe}
373	finally
374	LeaveCS;
375	end;
376	{$ENDIF}
377	end;
378
379	procedure TStDictionary.Assign(Source: TPersistent);
380	var
381	i : integer;
382	begin
383	{The only two containers that we allow to be assigned to a string
384	dictionary are (1) another string dictionary and (2) a Delphi string
385	list (TStrings)}
386	if (Source is TStDictionary) then
387	begin
388	Clear;
389	TStDictionary(Source).Iterate(AssignNode, Self);
390	end
391	else if (Source is TStrings) then
392	begin
393	Clear;
394	for i := 0 to pred(TStrings(Source).Count) do
395	Add(TStrings(Source).Strings[i], TStrings(Source).Objects[i]);
396	end
397	else
398	inherited Assign(Source);
399	end;
400
401	function TStDictionary.BinCount(H : Integer) : LongInt;
402	var
403	C : LongInt;
404	T : TStDictNode;
405	begin
406	{$IFDEF ThreadSafe}
407	EnterCS;
408	try
409	{$ENDIF}
410	C := 0;
411	T := dySymbols^[H];
412	while Assigned(T) do begin
413	inc(C);
414	T := T.dnNext;
415	end;
416	Result := C;
417	{$IFDEF ThreadSafe}
418	finally
419	LeaveCS;
420	end;
421	{$ENDIF}
422	end;
423
424	procedure TStDictionary.Clear;
425	begin
426	{$IFDEF ThreadSafe}
427	EnterCS;
428	try
429	{$ENDIF}
430	if FCount <> 0 then begin
431	Iterate(DestroyNode, nil);
432	FCount := 0;
433	FillChar(dySymbols^, LongInt(FHashSize)*SizeOf(TStDictNode), 0);
434	end;
435	{$IFDEF ThreadSafe}
436	finally
437	LeaveCS;
438	end;
439	{$ENDIF}
440	end;
441
442	constructor TStDictionary.Create(AHashSize : Integer);
443	begin
444	CreateContainer(TStDictNode, 0);
445	{FHashSize := 0;}
446	{$IFDEF WStrings}
447	FEqual := AnsiCompareTextShort32;
448	{$ELSE}
449	FEqual := AnsiCompareText;
450	{$ENDIF}
451	FHash := AnsiHashText;
452	HashSize := AHashSize;
453	end;
454
455	procedure TStDictionary.Delete(const Name : string);
456	var
457	H : Integer;
458	P, T : TStDictNode;
459	begin
460	{$IFDEF ThreadSafe}
461	EnterCS;
462	try
463	{$ENDIF}
464	dyFindNode(Name, H, P, T);
465	if Assigned(T) then begin
466	if Assigned(P) then
467	P.dnNext := T.dnNext
468	else
469	dySymbols^[H] := T.dnNext;
470	DestroyNode(Self, T, nil);
471	Dec(FCount);
472	end;
473	{$IFDEF ThreadSafe}
474	finally
475	LeaveCS;
476	end;
477	{$ENDIF}
478	end;
479
480	destructor TStDictionary.Destroy;
481	begin
482	if conNodeProt = 0 then
483	Clear;
484	if Assigned(dySymbols) then
485	FreeMem(dySymbols, LongInt(FHashSize)*SizeOf(TStDictNode));
486	IncNodeProtection;
487	inherited Destroy;
488	end;
489
490	function TStDictionary.DoEqual(const String1, String2 : string) : Integer;
491	begin
492	Result := 0;
493	if Assigned(FOnEqual) then
494	FOnEqual(Self, String1, String2, Result)
495	else if Assigned(FEqual) then
496	Result := FEqual(String1, String2);
497	end;
498
499	procedure TStDictionary.dyFindNode(const Name : string; var H : Integer;
500	var Prev, This : TStDictNode);
501	var
502	P, T : TStDictNode;
503	begin
504	Prev := nil;
505	This := nil;
506	H := Hash(Name, HashSize);
507	T := dySymbols^[H];
508	P := nil;
509	while Assigned(T) do begin
510	if DoEqual(Name, T.dnName) = 0 then begin
511	Prev := P;
512	This := T;
513	Exit;
514	end;
515	P := T;
516	T := T.dnNext;
517	end;
518
519	{Not found}
520	This := nil;
521	end;
522
523	procedure TStDictionary.dySetEqual(E : TStringCompareFunc);
524	begin
525	{$IFDEF ThreadSafe}
526	EnterCS;
527	try
528	{$ENDIF}
529	if Count = 0 then
530	FEqual := E;
531	{$IFDEF ThreadSafe}
532	finally
533	LeaveCS;
534	end;
535	{$ENDIF}
536	end;
537
538	procedure TStDictionary.dySetHash(H : TDictHashFunc);
539	begin
540	{$IFDEF ThreadSafe}
541	EnterCS;
542	try
543	{$ENDIF}
544	if Count = 0 then
545	FHash := H;
546	{$IFDEF ThreadSafe}
547	finally
548	LeaveCS;
549	end;
550	{$ENDIF}
551	end;
552
553	procedure TStDictionary.dySetHashSize(Size : Integer);
554	var
555	H, OldSize : Integer;
556	TableSize : LongInt;
557	T, N : TStDictNode;
558	OldSymbols : PSymbolArray;
559	OldDisposeData : TDisposeDataProc;
560	OldOnDisposeData : TStDisposeDataEvent;
561	begin
562	{$IFDEF ThreadSafe}
563	EnterCS;
564	try
565	{$ENDIF}
566	TableSize := LongInt(Size)*SizeOf(TStDictNode);
567	if (Size <= 0) {or (TableSize > MaxBlockSize)} then
568	RaiseContainerError(stscBadSize);
569
570	if Size <> FHashSize then begin
571	OldSymbols := dySymbols;
572	OldSize := FHashSize;
573
574	{Get a new hash table}
575	GetMem(dySymbols, TableSize);
576	FillChar(dySymbols^, TableSize, 0);
577	FCount := 0;
578	FHashSize := Size;
579
580	if OldSize <> 0 then begin
581	{Prevent disposing of the user data while transferring elements}
582	OldDisposeData := DisposeData;
583	DisposeData := nil;
584	OldOnDisposeData := OnDisposeData;
585	OnDisposeData := nil;
586	{Add old symbols into new hash table}
587	for H := 0 to OldSize-1 do begin
588	T := OldSymbols^[H];
589	while Assigned(T) do begin
590	Add(T.dnName, T.Data);
591	N := T.dnNext;
592	{free the node just transferred}
593	T.Free;
594	T := N;
595	end;
596	end;
597	{Dispose of old hash table}
598	FreeMem(OldSymbols, OldSize*SizeOf(TStDictNode));
599	{Reassign the dispose data routine}
600	DisposeData := OldDisposeData;
601	OnDisposeData := OldOnDisposeData;
602	end;
603
604	{FHashSize := Size;}
605	end;
606	{$IFDEF ThreadSafe}
607	finally
608	LeaveCS;
609	end;
610	{$ENDIF}
611	end;
612
613	function TStDictionary.Exists(const Name : String; var Data : Pointer) : Boolean;
614	var
615	H : Integer;
616	P, T : TStDictNode;
617	begin
618	{$IFDEF ThreadSafe}
619	EnterCS;
620	try
621	{$ENDIF}
622	dyFindNode(Name, H, P, T);
623	if Assigned(T) then begin
624	if Assigned(P) then begin
625	{Move T to front of list}
626	P.dnNext := T.dnNext;
627	T.dnNext := dySymbols^[H];
628	dySymbols^[H] := T;
629	end;
630	Result := True;
631	Data := T.Data;
632	end else
633	Result := False;
634	{$IFDEF ThreadSafe}
635	finally
636	LeaveCS;
637	end;
638	{$ENDIF}
639	end;
640
641	function TStDictionary.Find(Data : Pointer; var Name : string) : Boolean;
642	var
643	T : TStDictNode;
644	begin
645	Name := '';
646	{$IFDEF ThreadSafe}
647	EnterCS;
648	try
649	{$ENDIF}
650	T := Iterate(FindNodeData, Data);
651	if Assigned(T) then begin
652	Result := True;
653	Name := T.dnName;
654	end else
655	Result := False;
656	{$IFDEF ThreadSafe}
657	finally
658	LeaveCS;
659	end;
660	{$ENDIF}
661	end;
662
663	procedure TStDictionary.GetItems(S : TStrings);
664	var
665	H : Integer;
666	T : TStDictNode;
667	begin
668	S.Clear;
669	{$IFDEF ThreadSafe}
670	EnterCS;
671	try
672	{$ENDIF}
673	if FCount <> 0 then begin
674	for H := 0 to FHashSize-1 do begin
675	T := dySymbols^[H];
676	while Assigned(T) do begin
677	S.AddObject(T.Name, T.Data);
678	T := T.dnNext;
679	end;
680	end;
681	end;
682	{$IFDEF ThreadSafe}
683	finally
684	LeaveCS;
685	end;
686	{$ENDIF}
687	end;
688
689	procedure TStDictionary.SetItems(S : TStrings);
690	var
691	I : Integer;
692	begin
693	{$IFDEF ThreadSafe}
694	EnterCS;
695	try
696	{$ENDIF}
697	Clear;
698	for I := 0 to S.Count-1 do
699	Add(S.Strings[I], S.Objects[I]);
700	{$IFDEF ThreadSafe}
701	finally
702	LeaveCS;
703	end;
704	{$ENDIF}
705	end;
706
707	function TStDictionary.Iterate(Action : TIterateFunc;
708	OtherData : Pointer) : TStDictNode;
709	var
710	H : Integer;
711	T, N : TStDictNode;
712	begin
713	{$IFDEF ThreadSafe}
714	EnterCS;
715	try
716	{$ENDIF}
717	if FCount <> 0 then begin
718	for H := 0 to FHashSize-1 do begin
719	T := dySymbols^[H];
720	while Assigned(T) do begin
721	N := T.dnNext;
722	if Action(Self, T, OtherData) then
723	T := N
724	else begin
725	Result := T;
726	Exit;
727	end;
728	end;
729	end;
730	end;
731	Result := nil;
732	{$IFDEF ThreadSafe}
733	finally
734	LeaveCS;
735	end;
736	{$ENDIF}
737	end;
738
739	procedure TStDictionary.Join(D : TStDictionary; IgnoreDups : Boolean);
740	begin
741	{$IFDEF ThreadSafe}
742	EnterClassCS;
743	EnterCS;
744	D.EnterCS;
745	try
746	{$ENDIF}
747	dyIgnoreDups := IgnoreDups;
748	D.Iterate(JoinNode, Self);
749
750	{Dispose of D, but not its nodes}
751	D.IncNodeProtection;
752	D.Free;
753	{$IFDEF ThreadSafe}
754	finally
755	D.LeaveCS;
756	LeaveCS;
757	LeaveClassCS;
758	end;
759	{$ENDIF}
760	end;
761
762	procedure TStDictionary.Update(const Name : string; Data : Pointer);
763	var
764	H : Integer;
765	P, T : TStDictNode;
766	begin
767	{$IFDEF ThreadSafe}
768	EnterCS;
769	try
770	{$ENDIF}
771	dyFindNode(Name, H, P, T);
772	if Assigned(T) then
773	T.Data := Data;
774	{$IFDEF ThreadSafe}
775	finally
776	LeaveCS;
777	end;
778	{$ENDIF}
779	end;
780
781	procedure TStDictionary.LoadFromStream(S : TStream);
782	var
783	Data : pointer;
784	Reader : TReader;
785	StreamedClass : TPersistentClass;
786	StreamedNodeClass : TPersistentClass;
787	StreamedClassName : string;
788	StreamedNodeClassName : string;
789	St : string;
790	begin
791	{$IFDEF ThreadSafe}
792	EnterCS;
793	try
794	{$ENDIF}
795	Clear;
796	Reader := TReader.Create(S, 1024);
797	try
798	with Reader do
799	begin
800	StreamedClassName := ReadString;
801	StreamedClass := GetClass(StreamedClassName);
802	if (StreamedClass = nil) then
803	RaiseContainerErrorFmt(stscUnknownClass, [StreamedClassName]);
804	if (StreamedClass <> Self.ClassType) then
805	RaiseContainerError(stscWrongClass);
806	StreamedNodeClassName := ReadString;
807	StreamedNodeClass := GetClass(StreamedNodeClassName);
808	if (StreamedNodeClass = nil) then
809	RaiseContainerErrorFmt(stscUnknownNodeClass, [StreamedNodeClassName]);
810	if (StreamedNodeClass <> conNodeClass) then
811	RaiseContainerError(stscWrongNodeClass);
812	HashSize := ReadInteger;
813	ReadListBegin;
814	while not EndOfList do
815	begin
816	St := ReadString;
817	Data := DoLoadData(Reader);
818	Add(St, Data);
819	end;
820	ReadListEnd;
821	end;
822	finally
823	Reader.Free;
824	end;
825	{$IFDEF ThreadSafe}
826	finally
827	LeaveCS;
828	end;
829	{$ENDIF}
830	end;
831
832	procedure TStDictionary.StoreToStream(S : TStream);
833	var
834	H : Integer;
835	Walker : TStDictNode;
836	Writer : TWriter;
837	begin
838	{$IFDEF ThreadSafe}
839	EnterCS;
840	try
841	{$ENDIF}
842	Writer := TWriter.Create(S, 1024);
843	try
844	with Writer do
845	begin
846	WriteString(Self.ClassName);
847	WriteString(conNodeClass.ClassName);
848	WriteInteger(HashSize);
849	WriteListBegin;
850	if (Count <> 0) then
851	for H := 0 to FHashSize-1 do
852	begin
853	Walker := dySymbols^[H];
854	while Assigned(Walker) do
855	begin
856	WriteString(Walker.dnName);
857	DoStoreData(Writer, Walker.Data);
858	Walker := Walker.dnNext;
859	end;
860	end;
861	WriteListEnd;
862	end;
863	finally
864	Writer.Free;
865	end;
866	{$IFDEF ThreadSafe}
867	finally
868	LeaveCS;
869	end;
870	{$ENDIF}
871	end;
872
873	{$IFDEF ThreadSafe}
874	initialization
875	Windows.InitializeCriticalSection(ClassCritSect);
876	finalization
877	Windows.DeleteCriticalSection(ClassCritSect);
878	{$ENDIF}
879	end.