Unit DirectoryTree;

{
  Tento soubor implementuje struktury a rutiny pro vytvoreni pametove
  kopie adresarove struktury jmenneho prostoru spravce objektu. Dalsi
  moduly pak maji za ukol tuto kopii zobrazovat.
}

Interface

Type
  // Struktura jedne polozky (objektu)
  PTreeEntry = ^TTreeEntry;
  TTreeEntry = Record
    // Jmeno
    Name : WideString;
    // Cele jmeno (vcetne cesty)
    FullName : WideString;
    // Nazev typu
    TypeName : WideString;
    // Odkaz na rodicovsky adresar
    Parent : PTreeEntry;
    // Seznam potomku (platny pouze u adresaru)
    Childs : Array Of PTreeEntry;
    end;

Function DirectoryTreeRoot:PTreeEntry;
Function DirectoryTreeInit:Boolean;
Procedure DirectoryTreeFinit;

Implementation

Uses
  Windows, Classes, SysUtils, Objects, Utils;


Var
  // Odkaz na korenovy adresar
  Root : PTreeEntry;

Function TreeEntryCreate(Name:WideString; FullName:WideString; TypeName:WideString):PTreeEntry;
{
  Vytvori novy zaznam TTreeEntry popisujici objekt, jehoz udaje
  jsou zadany v parametrech.
}
begin
Result := HeapAlloc(GetProcessHeap, 0, SizeOf(TTreeEntry));
If Assigned(Result) Then
  begin
  ZeroMemory(Result, SizeOf(TTreeEntry));
  Result.Name := Name;
  Result.FullName := FullName;
  Result.TypeName := TypeName;
  Result.Childs := Nil;
  Result.Parent := Nil;
  end;
end;

Procedure TreeEntryDestroy(Entry:PTreeEntry; WalkSubtree:Boolean = False);
{
  Uvolni zaznam TTreeEntry z pameti. Pokud je parametr WalkSubtree
  nastaven na True, uvolnovani je provedeno rekurzivne.
}
Var
  I : Integer;
begin
Entry.Name := '';
Entry.FullName := '';
Entry.TypeName := '';
If WalkSubtree Then
  begin
  For I := Low(Entry.Childs) To High(Entry.Childs) Do
    TreeEntryDestroy(Entry.Childs[I], True);
  end;

Entry.Childs := Nil;
HeapFree(GetProcessHeap, 0, Entry);
end;

Procedure TreeEntryAddChild(Entry:PTreeEntry; Child:PTreeEntry);
{
  Prida novy zaznam TTreeEntry do seznamu deti jineho zaznamu
  TTreeEntry.
}
begin
Child.Parent := Entry;
SetLength(Entry.Childs, Length(Entry.Childs) + 1);
Entry.Childs[High(Entry.Childs)] := Child;
end;

Function WalkNamespace(Directory:PTreeEntry):Boolean;
{
  Projde adresar Directory aa naplniho podle stavu daneho adresare
  ve jmennem prostoru spravce objektu. Nasledne pokracuje rekurzivnim
  naplnovanim jeho polozek. Rutina tak provadi kopirovani jmenneho
  prostoru spravce objektu.
}
Var
  ObjHandle : Int64;
  OTI : OBJECT_TYPE_INFO;
  Entries : TStrings;
  EntryHandle : Int64;
  EntryPath : WideString;
  I : Integer;
  TypeName : WideString;
  NewEntry : PTreeEntry;
begin
Result := False;
ObjHandle := ObjectOpen(Directory.FullName);
Result := ObjHandle <> 0;
If Result Then
  begin
  Entries := DirectoryEnumerate(ObjHandle);
  Result := Assigned(Entries);
  If Result Then
    begin
    For I := 0 To Entries.Count - 1 Do
      begin
      If Directory.FullName = '\' Then
        EntryPath := Directory.FullName + Entries[I]
      Else EntryPath := Directory.FullName + '\' + Entries[I];

      EntryHandle := ObjectOpen(EntryPath);
      Result := EntryHandle <> 0;
      If Result Then
        begin
        TypeName := '<chyba>';
        Result := ObjectGetTypeInfo(EntryHandle, @OTI);
        If Result Then
          TypeName := OTI.Name;

        NewEntry := TreeEntryCreate(Entries[I], EntryPath, TypeName);
        Result := Assigned(NewEntry);
        If Result Then
          begin
          TreeEntryAddChild(Directory, NewEntry);
          If TypeName = 'Directory' Then
            WalkNamespace(NewEntry);
          end;

        ObjectClose(EntryHandle);
        end;
      end;

    Entries.Free;
    end;

  ObjectClose(ObjHandle);
  end;
end;

Function DirectoryTreeInit:Boolean;
{
  Pokud jiz existuje kopie jmenneho prostoru spravce objektu, rutina
  ji uvolni z pameti. Dale vytvori koppi novou, aktualni.
}
begin
Result := False;
If Assigned(Root) Then
  DirectoryTreeFinit;

Root := TreeEntryCreate('\', '\', 'Directory');
Result := Assigned(Root);
If Result Then
  WalkNamespace(Root);
end;

Function DirectoryTreeRoot:PTreeEntry;
{
  Vrati odkaz na zaznam TTreeEntry reprezentujici korenovy adresar
  kopie jmenneho prostoru spravce objektu.
}
begin
Result := Root;
end;

Procedure DirectoryTreeFinit;
{
  Odstrani kopii jmenneho prostoru spravce objektu z pameti
}
begin
TreeEntryDestroy(Root, True);
Root := Nil;
end;

Initialization
Root := Nil;
End.

