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

 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: Dirs

 Directories List. Each File is Splitted in FileName/directory
 and directories Are stored in one Global huge List to Make
 Memory usage Lower by Joining duplicates

*********************************************************}
unit Dirs;

interface

uses
  Windows, SysUtils, STypes;

type
  PDirectoryItem = ^TDirectoryItem;
  TDirectoryItem = Packed record
    Directory: string; // Directory name
    Crc: Integer; // Directory CRC (StringCRC)
    Count: Integer; // Number of files that match directory
    Prev: PDirectoryItem; // Previous item in list
    Next: PDirectoryItem; // Next item in list
  end;

function AddDirectory(Folder: string): PDirectoryItem;
function GetDirectory(Dir: PDirectoryItem): string;
procedure DelDirectory(Dir: PDirectoryItem);

implementation

uses
  Handler, Vars;

const
  DIRS_MAX = 8192;

var
  Lists: array[0..DIRS_MAX - 1] of PDirectoryItem;
    // Pointers to First items in arrays

function DirectoryCRC(Folder: string): Integer;
var
  Len: Integer;
begin // Count CRC of Folder. for indexing
  Tmp_Pos := 1589;
  Len := Length(Folder);
  Result := Len;
  if Len > 0 then
    Inc(Result, Ord(Folder[1]) shl 3);
  if Len > 1 then
    Inc(Result, Ord(Folder[2]) shl 6);
  if Len > 2 then
    Inc(Result, Ord(Folder[3]) shl 9);
  Result := Result and (DIRS_MAX - 1);
  Tmp_Pos := 1590;
end;

function AddDirectory(Folder: string): PDirectoryItem;
var
  P: PDirectoryItem;
  Crc, StrCrc: Integer;
  Found: Boolean;
begin
  Tmp_Pos := 1591;
  if Length(Folder) < 1 then
  begin
    Result := nil;
    Exit;
  end;
  Crc := DirectoryCRC(Folder);
  StrCrc := StringCRC(Folder, False);
  P := Lists[Crc];
  Found := False;
  Tmp_Pos := 1592;
  while not Found do
  begin
    if P = nil then
      Found := True
    else if P^.Crc = StrCrc then
      if P^.Directory = Folder then
        Found := True;
    if not Found then
      P := P^.Next;
  end;
  Tmp_Pos := 1593;
  if P <> nil then
  begin
    Inc(P^.Count);
    Result := P;
    // Set result to first item so next time search would be faster
    if Lists[Crc] <> P then
    begin
      Tmp_Pos := 1594;
      P := Lists[Crc];
      Lists[Crc] := Result;
      // Deleting "Result" from list
      if Result^.Next <> nil then
        Result^.Next^.Prev := Result^.Prev;
      if Result^.Prev <> nil then
        Result^.Prev^.Next := Result^.Next;
      // Moving "P" to second place
      P^.Prev := Result;
      Result^.Prev := nil;
      Result^.Next := P;
    end;
    Exit;
  end;
  // No such item. Creating new one
  Tmp_Pos := 1595;
  P := AllocMem(SizeOf(TDirectoryItem));
  Pointer(P^.Directory) := nil;
  P^.Directory := Folder;
  P^.Crc := StrCrc;
  P^.Count := 1;
  P^.Prev := nil;
  P^.Next := Lists[Crc];
  if Lists[Crc] <> nil then
    Lists[Crc]^.Prev := P;
  Lists[Crc] := P;
  Result := P;
  Tmp_Pos := 1596;
end;

function GetDirectory(Dir: PDirectoryItem): string;
begin
  Tmp_Pos := 1597;
  if Dir = nil then
    Result := ''
  else
    Result := Dir^.Directory;
  Tmp_Pos := 1598;
end;

procedure DelDirectory(Dir: PDirectoryItem);
var
  Crc: Integer;
begin
  Tmp_Pos := 1599;
  if (Dir = nil) or (not Running) then Exit;
  Dec(Dir^.Count);
  if Dir^.Count > 0 then Exit;
  // Item is empty. Deleting it.
  Tmp_Pos := 1600;
  if Dir^.Next <> nil then
    Dir^.Next^.Prev := Dir^.Prev;
  if Dir^.Prev <> nil then
    Dir^.Prev^.Next := Dir^.Next
  else // First item in list
  begin
    Crc := DirectoryCRC(Dir^.Directory);
    Lists[Crc] := Dir^.Next;
  end;
  Tmp_Pos := 1601;
  Dir^.Directory := '';
  FreeMem(Dir, SizeOf(TDirectoryItem));
  Tmp_Pos := 1602;
end;

procedure InitDirs;
var
  I: Integer;
begin
  for I := 0 to DIRS_MAX - 1 do
    Lists[I] := nil;
end;

procedure FreeDirs;
begin
  // Right now all items are freed when it is unshared.
end;

initialization
  begin
    InitDirs;
  end;

finalization
  begin
    FreeDirs;
  end;

end.
