{*********************************************************

 SlavaNap source code.

 Copyright 2001,2002 by SlavaNap development team
 Released under GNU General Public License

 Latest version is available at
 http://www.slavanap.org

**********************************************************

 Unit: slavastrings

 TStringList replacement

*********************************************************}
unit slavastrings;

interface

uses
 SysUtils, Classes2, Windows;

type
 PStringHashItem=^TStringHashItem;
 TStringHashItem=packed record
   data: String;
   next: PStringHashItem;
 end;
 TStringHash=packed record
   count: Integer;
   first: PStringHashItem;
 end;
 PStringHash=^TStringHash;

function StrHash_Create: PStringHash;
procedure StrHash_Reset(var hash: TStringHash);
function StrHash_Free(hash: PStringHash): PStringHash;
procedure StrHash_Clear(var hash: TStringHash);
function StrHash_Add(var hash: TStringHash; str: String): PStringHashItem;
function StrHash_AddEx(var hash: TStringHash; str: String): PStringHashItem;
function StrHash_Delete(var hash: TStringHash; str: String; ignore_case: Boolean): Boolean;
procedure StrHash_DeleteFirst(var hash: TStringHash);
function StrHash_FindString(hash: TStringHash; str: String; ignore_case: Boolean): Boolean;
function StrHash_FindStringEx(hash: TStringHash; str: String; ignore_case: Boolean): String;
function StrHash_LoadFromFile(var hash: TStringHash; filename: String): Boolean;
function StrHash_SaveToFile(hash: TStringHash; filename: String): Boolean;
function StrHash_SaveToFileSorted(hash: TStringHash; filename: String): Boolean;
procedure StrHash_CopyToStringList(hash: TStringHash; list: TMyStringList);
procedure StrHash_Copy(src: TStringHash; var dst: TStringHash);
procedure StrHash_Reverse(var hash: TStringHash);
function StrHash_Equal(h1,h2: TStringHash): Boolean;

implementation

uses
 stypes, memory_manager;

function StrHash_Create: PStringHash;
var
 hash: PStringHash;
begin
 hash:=AllocMem(Sizeof(TStringHash));
 hash^.first:=nil;
 hash^.count:=0;
 Result:=hash;
end;

procedure StrHash_Reset(var hash: TStringHash);
begin
 hash.first:=nil;
 hash.count:=0;
end;

function StrHash_Free(hash: PStringHash): PStringHash;
begin
 Result:=nil;
 if hash=nil then exit;
 StrHash_Clear(hash^);
 Finalize(hash^);
 FreeMem(hash,sizeof(TStringHash));
end;

procedure StrHash_Clear(var hash: TStringHash);
var
 item: PStringHashItem;
begin
 while hash.first<>nil do
 begin
   item:=hash.first;
   hash.first:=item^.next;
   item^.data:='';
   Finalize(item^);
   FreeMem(item,Sizeof(TStringHashItem));
 end;
 hash.count:=0;
end;

function StrHash_Add(var hash: TStringHash; str: String): PStringHashItem;
var
 item: PStringHashItem;
begin
 item:=AllocMem(Sizeof(TStringHashItem));
 Pointer(item^.data):=nil;
 item^.data:=str;
 item^.next:=hash.first;
 hash.first:=item;
 inc(hash.count);
 Result:=item;
end;

function StrHash_AddEx(var hash: TStringHash; str: String): PStringHashItem;
var
 item,prev: PStringHashItem;
begin
 item:=AllocMem(Sizeof(TStringHashItem));
 Pointer(item^.data):=nil;
 item^.data:=str;
 item^.next:=nil;
 inc(hash.count);
 Result:=item;
 if hash.first=nil then hash.first:=item
 else begin
   prev:=hash.first;
   while prev^.next<>nil do
    prev:=prev^.next;
   prev^.next:=item; 
 end;
end;

function StrHash_Delete(var hash: TStringHash; str: String; ignore_case: Boolean): Boolean;
var
 prev,item: PStringHashItem;
begin
 if ignore_case then str:=AnsiLowerCase(str);
 prev:=nil;
 item:=hash.first;
 while item<>nil do
 begin
    if (ignore_case and (AnsiLowerCase(item^.data)=str)) or ((ignore_case=false) and (item^.data=str)) then
    begin
      if prev=nil then hash.first:=item^.next
      else prev^.next:=item^.next;
      item^.data:='';
      dec(hash.count);
      Finalize(item^);
      FreeMem(item,Sizeof(TStringHashItem));
      Result:=true;
      exit;
    end;
   prev:=item;
   item:=item^.next;
 end;
 Result:=false;
end;

procedure StrHash_DeleteFirst(var hash: TStringHash);
var
 item: PStringHashItem;
begin
 if hash.first=nil then exit;
 item:=hash.first;
 hash.first:=item^.next;
 dec(hash.count);
 item^.data:='';
 Finalize(item^);
 FreeMem(item,Sizeof(TStringHashItem));
end;

function StrHash_FindString(hash: TStringHash; str: String; ignore_case: Boolean): Boolean;
var
 item: PStringHashItem;
begin
 item:=hash.first;
 if ignore_case then str:=AnsiLowerCase(str);
 while item<>nil do
 begin
    if (ignore_case and (AnsiLowerCase(item^.data)=str)) or ((ignore_case=false) and (item^.data=str)) then
    begin
      Result:=true;
      exit;
    end;
   item:=item^.next;
 end;
 Result:=false;
end;

function StrHash_FindStringEx(hash: TStringHash; str: String; ignore_case: Boolean): String;
var
 item: PStringHashItem;
begin
 item:=hash.first;
 if ignore_case then str:=AnsiLowerCase(str);
 while item<>nil do
 begin
    if (ignore_case and (AnsiLowerCase(item^.data)=str)) or ((ignore_case=false) and (item^.data=str)) then
    begin
      Result:=item^.data;
      exit;
    end;
   item:=item^.next;
 end;
 Result:='';
end;

function StrHash_LoadFromFile(var hash: TStringHash; filename: String): Boolean;
var
 list: TMyStringList;
 i: Integer;
begin
 StrHash_Clear(hash);
 list:=CreateStringList;
 try
  list.LoadFromFile(filename);
  except
   FreeStringList(list);
   Result:=false;
   exit;
 end;
 for i:=list.count-1 downto 0 do
  StrHash_Add(hash,list.Strings[i]);
 FreeStringList(list);
 Result:=true;
end;

function StrHash_SaveToFile(hash: TStringHash; filename: String): Boolean;
var
 list: TMyStringList;
begin
 list:=CreateStringList;
 StrHash_CopyToStringList(hash,list);
 Result:=true;
 try
  list.SaveToFile(filename);
  except
   Result:=false;
 end;
 FreeStringList(list);
end;

function StrHash_SaveToFileSorted(hash: TStringHash; filename: String): Boolean;
var
 list: TMyStringList;
begin
 list:=CreateStringList;
 StrHash_CopyToStringList(hash,list);
 list.Sort;
 Result:=true;
 try
  list.SaveToFile(filename);
  except
   Result:=false;
 end;
 FreeStringList(list);
end;

procedure StrHash_CopyToStringList(hash: TStringHash; list: TMyStringList);
var
 item: PStringHashItem;
begin
 list.Clear;
 item:=hash.first;
 while item<>nil do
 begin
   list.Add(item^.data);
   item:=item^.next;
 end;
end;

procedure StrHash_Reverse(var hash: TStringHash);
var
 item,prev,next: PStringHashItem;
begin
 if hash.count<2 then exit;
 item:=hash.first;
 prev:=nil;
 while item<>nil do
 begin
   next:=item^.next;
   item^.next:=prev;
   prev:=item;
   item:=next;
 end;
 hash.first:=prev;
end;

procedure StrHash_Copy(src: TStringHash; var dst: TStringHash);
var
 f,t,prev,item: PStringHashItem;
begin
 StrHash_Clear(dst);
 t:=src.first;
 prev:=nil;
 f:=nil;
 item:=nil;
 while t<>nil do
 begin
   item:=StrHash_Add(dst,t^.data);
   if prev=nil then f:=item
   else prev^.next:=item;
   prev:=item;
   item^.next:=nil;
   t:=t^.next;
 end;
 dst.first:=f;
end;

function StrHash_Equal(h1,h2: TStringHash): Boolean;
var
 p: PStringHashItem;
begin
 Result:=false;
 if h1.count<>h2.count then exit;
 p:=h1.first;
 while p<>nil do
 begin
   if not StrHash_FindString(h2,p^.data,false) then exit;
   p:=p^.next;
 end;
 Result:=true;
end;


end.
