(************************************************************************
*    This File is Part of the AHM Triton Tools                          *
*    for Borland Delphi and C++ Builder.                                *
*************************************************************************
* Copyright © 1995-1999 Alexander H. Mehlhorn (AHM) and Tritontools.com *
* All Rights reserved.                                                  *
*                                                                       *
*    For more Information contact us at                                 *
*    E-Mail : support@tritontools.com                                   *
*    URL : http://www.tritontools.com                                   *
*                                                                       *
*    AHM is copyright by Alexander H. Mehlhorn                          *
*    All Parts of this Collection were developed,                       *
*    designed and implemented by AHM                                    *
*                                                                       *
*    Under no Circumstances may you distribute this file                *
*    in this or any other format. This File is supplied                 *
*    as Evaluation of Source only. No Delphi Components may be developed*
*    using extracts or subsets of this code without expressed permission*
*    by AHM.                                                            *
*                                                                       *
*************************************************************************)
unit AHMTExplorerTree;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls,
  ComCtrls,AHMStdClass,ShellApi,Forms,AHMStandardConst;

type
  TAHMAddFileEvent = procedure (Sender : TObject ; FileName : String ; var DoAdd : Boolean) of object;
  TAHMFindDirectoryEvent =procedure(Sender : TObject;Path : String;var Result : Integer;const First : Boolean) of Object;
  TAHMExplorerTree = class(TcustomTreeView)
  private
    FAboutStr : TAHMAboutSControlStr;
    fFastLoad : Boolean;
    fIList : TImageList;
    fActDirs : array['A'..'Z'] of String;
    FOnAddDirectory : TAHMAddFileEvent;
    FOnDeleteDirectory : TTVExpandedEvent;
    FOnGetIcon  : TTVExpandedEvent;
    FOnFindDirectory  : TAHMFindDirectoryEvent;
    fIFolS : Integer;
    fIFolN : Integer;
    fAllowChange : Boolean;
    FNetwork  : Boolean;
    fWinDir  : String;
    procedure DelItem (Sender: TObject; Node: TTreeNode);
  protected
    procedure CreateWnd; override;
    procedure ReadNew;
    procedure AddNode(var Item : TTreeNode;A : String);
    procedure GetSubKids(Par : TTreeNode);
    procedure SetDrive(Val : Char);
    procedure SetDirectory(Val : String);
    procedure Change(Node: TTreeNode); override;
    procedure SetNetAllow (Val : Boolean);
    procedure ClearList;
    procedure Loaded; override;
    procedure TreeGetImageIndex(Node:TTreeNode;NormalIcon:Integer);
    function CanExpand(Node: TTreeNode): Boolean ; override;
    function GetDirectory : String;
    function GetDrive : Char;
    function AddKid (Par : TTreeNode; A : String) : TTreeNode;
    function GetDragDropFolder : String;
    function AskAdd (FNam : String):Boolean;
    function IsExpanded(Item : TTreeNode):Boolean;
    property Items stored False;
    procedure GetBtn (var Item : TTreeNode);
    procedure GetDirChildren (var Item : TTreeNode);
  public
    constructor Create (AOwner: TComponent);override;
    destructor Destroy; override;
    procedure Reload;
    procedure FullExpand;
    procedure RenamePath(OldPath,NewName : String);
    procedure DeletePath(DPath : String);
    procedure AddPath(NewPath,NewSub : String);
    procedure ClearNode (Node:TTreeNode);
    function GetNodeFromPath (Path : String):TTreeNode;
    property Drive : Char read GetDrive write SetDrive;
    property DragDropFolder : String read GetDragDropFolder;
    property ShellIcons : TImageList read fIList;
  published
    property About : TAHMAboutSControlStr read FAboutStr write FAboutStr;
    {$IFDEF AHMONLY4}
    property Anchors;
    property BiDiMode;
    property Constraints;
    property DragKind;
    property ParentBiDiMode;
    {$ENDIF}
    property Directory : String read GetDirectory write SetDirectory;
    property OnAddDirectory : TAHMAddFileEvent read FOnAddDirectory write FOnAddDirectory;
    property OnDeleteItem : TTVExpandedEvent read FOnDeleteDirectory write FOnDeleteDirectory;
    property OnGetIcon : TTVExpandedEvent read fOnGetIcon write fOnGetIcon;
    property OnFindDirectory : TAHMFindDirectoryEvent read FOnFindDirectory write FOnFindDirectory;
    property BorderStyle;
    property DragCursor;
    property Network : Boolean read FNetwork write SetNetAllow;
    property FastLoad : Boolean read fFastLoad write fFastLoad;
    property ReadOnly;
    property DragMode;
    property HideSelection;
    property OnEditing;
    property OnEdited;
    property OnExpanding;
    property OnExpanded;
    property OnCollapsing;
    property OnCollapsed;
    property OnChanging;
    property OnChange;
    property Align;
    property Enabled;
    property Font;
    property Color;
    property ParentColor;
    property ParentCtl3D;
    property Ctl3D;
    property TabOrder;
    property TabStop default True;
    property Visible;
    property OnClick;
    property OnEnter;
    property OnExit;
    property OnDragDrop;
    property OnDragOver;
    property OnStartDrag;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnDblClick;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property PopupMenu;
    property ParentFont;
    property ParentShowHint;
    property ShowHint;
  end;

function AHMGetSystemPath (Path : String) : String;
function AHMGetShellPath (Path : String) : String;
function AHMShellItemExists (Path : String):Boolean;

implementation
type
  TAHMDirectoryRecord = packed record
    Attr   : Integer;
    Name   : String;
    Handle : Integer;
    Data   : TWin32FindData;
  end;
  PAHMDirectoryEntry = ^TAHMDirectoryEntry;
  TAHMDirectoryEntry = packed record
    Name     : String;
    IsExp    : Boolean;
  end;


function FindFirstDir(Path : String;var Rec:TAHMDirectoryRecord):Integer;
begin
  with Rec do
  begin
    Result := 0;
    FillChar(Rec,SizeOf(TAHMDirectoryRecord),0);
    Handle:=FindFirstFile(PChar(Path),Data);
    Attr := Data.dwFileAttributes;
    Name := Data.cFileName;
  end;
end;
function FindNextDir(var Rec:TAHMDirectoryRecord):Integer;
begin
  with Rec do
  begin
    if FindNextFile(Handle,Data) then
    begin
      Result := 0;
      Attr := Data.dwFileAttributes;
      Name := Data.cFileName
    end else Result := GetLastError;
  end;
end;
procedure MakeTAHMDirectoryEntry(a:TTreeNode;b : String;c:Boolean);
var d : PAHMDirectoryEntry;
begin
  d := New(PAHMDirectoryEntry);
  d^.IsExp := c;
  d^.Name := b;
  a.Data:=d;
end;
function AzPos(a : String) : Integer;
var ct: Integer;
begin
  Result := 0;
  repeat
    ct := Pos ('\',a);
    if ct = 0 then Exit;
    Inc (Result,1);
    a:=Copy(a,ct+1,MaxInt);
  until False;
end;
function GetPath(a : String;b : Integer) : String;
var ct,ix : Integer;
begin
  Result := a;
  ix := 0;
  for ct := 1 to Length(a) do
  begin
    if a[ct] = '\' then Inc (ix,1);
    if ix = b then
    begin
      Result := Copy(a,1,ct);
      Exit;
    end;
  end;
end;
procedure AddBSlash(var Val : String);
begin
  if Val <> '' then
  if Val[Length(Val)] <> '\' then Val := Val+'\';
end;

function DelBSlash(Val : String) : String;
begin
  if Val <> '' then
  if Val[Length(Val)] = '\' then Delete(Val,Length(Val),1);
  Result := val;
end;

function EntryName(Node : TTreeNode) : String;
begin
  Result := '';
  if Assigned(Node.Data) then Result := PAHMDirectoryEntry(Node.Data)^.Name;
end;

function GetSysShellName(NewPath : String;Shell : Boolean) : String;
var az,afg : Integer;
    Path   : String;
function GetSysFileName(Name : String) : String;
var rec : TAHMDirectoryRecord;
begin
  Name := DelBSlash(Name);
  Result := ExtractFileName(Name);
  if FindFirstDir(Name,rec) = 0 then Result := rec.Name;
  Windows.FindClose(rec.Handle);
  AddBSlash(Result);
end;

function GetShellFileName(Name : String) : String;
var sfi : TSHFileInfo;
begin
  Name := DelBSlash(Name);
  Result := ExtractFileName(Name);
  if SHGetFileInfo(PChar(Name),0,sfi,SizeOf(TSHFileInfo),SHGFI_DISPLAYNAME) <> 0 then
     Result := sfi.szDisplayName;
     AddBSlash(Result);
end;

begin
  Path := DelBSlash(Path);
  Result := Path;
  if not AHMShellItemExists(Path) then Exit;
  az := AzPos(Path)+1;
  if az < 2 then
  begin
    if Path <> '' then Path[1] := UpCase(Path[1]);
    Exit;
  end;
  Result := UpCase(Path[1])+':\';
  AddBSlash(Path);
  for afg := 2 to az do
  begin
    Path := GetPath(Path,afg);
    if Shell then Result := Result+GetShellFileName(Path)
             else Result := Result+GetSysFileName(Path);
  end;
  Result := DelBSlash(Result);
end;

function AHMGetSystemPath(Path : String) : String;
begin
  Result := GetSysShellName(Path,False);
end;

function AHMGetShellPath(Path : String) : String;
begin
  Result := GetSysShellName(Path,True);
end;

function AHMShellItemExists(Path : String) : Boolean;
var E : Integer;
begin
  result:=true;
  E := SetErrorMode(SEM_FAILCRITICALERRORS);
  try
    GetFileAttributes(PChar(Path));
  finally
    SetErrorMode(E);
  end;
end;

constructor TAHMExplorerTree.Create;
var sfi : TSHFileInfo;
    n   : Char;
    tp  : array [0..MAX_PATH] of char;
begin
  inherited Create(AOwner);
  fIList := TImageList.Create(Self);
  GetWindowsDirectory(tp,MAX_PATH);
  fWinDir := StrPas(tp);
  AddBSlash(fWinDir);
  fIList.Handle := SHGetFileInfo(tp,0,sfi,SizeOf(TSHFileInfo),SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
  fIList.ShareImages := True;
  Images := fIList;
  fIFolN := sfi.iIcon;
  SHGetFileInfo(tp,0,sfi,SizeOf(TSHFileInfo), SHGFI_OPENICON or SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
  fIFolS := sfi.iIcon;
  fFastLoad := False;
  OnDeletion := DelItem;
  for n := 'A' to 'Z' do
    fActDirs[n]:=UpperCase(n)+':\';
  try
    fActDirs[UpCase(GetCurrentDir[1])] := UpperCase(GetCurrentDir);
  except;
  end;
  SortType := stNone;
  HideSelection := False;
  fAllowChange := False;
 FNetwork := True;
  fOnGetIcon := nil;
  FOnFindDirectory := nil;
end;


procedure TAHMExplorerTree.ClearList;
var ct : Integer;
begin
 if Items.Count > 0 then
 for ct := 0 to Items.Count -1 do
 try
   if Items[ct].Data <> nil then
   begin
     PAHMDirectoryEntry(Items[ct].Data)^.Name := '';
     Dispose(PAHMDirectoryEntry(Items[ct].Data));
   end;
 finally
   Items[ct].Data := nil;
 end;
 Items.Clear;
end;


destructor TAHMExplorerTree.Destroy;
begin
  fAllowChange := False;
  ClearList;
  fIList.Free;
  inherited Destroy;
end;

procedure TAHMExplorerTree.TreeGetImageIndex(Node : TTreeNode;NormalIcon : Integer);
var Info : TSHFileInfo;
begin
  Node.ImageIndex := NormalIcon;
  if NormalIcon = fIFolN then Node.SelectedIndex := fIFolS else
  begin
    FillChar(Info,SizeOF(TSHFileInfo),0);
    SHGetFileInfo(PChar(PAHMDirectoryEntry(Node.Data)^.Name),0,Info,SizeOf(TSHFileInfo),
    SHGFI_SYSICONINDEX or SHGFI_SMALLICON or SHGFI_OPENICON);
    Node.SelectedIndex := Info.iIcon;
  end;
  if Assigned(fOnGetIcon) then fOnGetIcon(Self,Node);
end;

function TAHMExplorerTree.GetDragDropFolder : String;
begin
  Result := '';
  try
    if DropTarget<>nil then Result := EntryName(DropTarget);
  finally
  end;
end;


procedure TAHMExplorerTree.Reload ;
var t        : Char;
    node,nd1 : TTreeNode;
    tdir     : String;
begin
  tdir := GetDirectory;
  ReadNew;
  SetDirectory(tdir);
  if Items.Count = 0 then Exit;
  if Selected = nil then SetDirectory(Copy(tdir,1,3));
  if Selected = nil then
  begin
    node := Items.GetFirstNode;
    nd1 := Node.GetFirstChild;
    while (nd1 <> nil) and (not IsExpanded(nd1)) and (Node.GetNextSibling <> nil) do
    begin
      node := node.GetNextSibling;
      nd1 := node.GetFirstChild;
    end;
    t := UpCase(EntryName(node)[1]);
    try
      SetDirectory(fActDirs[t]);
      if GetDirectory <> fActDirs[t] then
      begin
        node.Selected := True;
        Change(node);
      end;
    except
    end;
  end;
end;

function TAHMExplorerTree.AskAdd (FNam : String):Boolean;
var c : integer;
begin
  Result := True;
  c:= Pos('\recycled\',AnsiLowerCase(FNam));
  if c > 0 then  if c < (Length(FNam) -9) then Result:=False;
  if Result and Assigned (FOnAddDirectory) then FOnAddDirectory(Self,FNam,Result);
end;

procedure TAHMExplorerTree.SetNetAllow (Val : Boolean);
begin
  if Val <> FNetwork then
  begin
    FNetwork := Val;
    ReLoad;
  end;
end;

procedure TAHMExplorerTree.SetDirectory (Val : String);
var az     : Integer;
    node   : TTreeNode;
    oldcur : TCursor;
    afg    : Integer;
    tsr    : String;
function GetRoot(a : String):TTreeNode;
var sr : TTreeNode;
begin
  Result:=nil;
  sr := Items.GetFirstNode;
  while sr <> nil do
  begin
    if lstrcmpi(PChar(a),PChar(EntryName(sr))) = 0 then
    begin
      if not IsExpanded(sr) then GetDirChildren(sr);
      Result:=sr;
      Break;
    end;
    sr := sr.GetNextSibling;
  end;
end;

function GetChi(c:TTreeNode;a : String):TTreeNode;
var sr : TTreeNode;
begin
  Result:=nil;
  sr := c.GetFirstChild;
  while sr <> nil do
  begin
    if lstrcmpi(PChar(a),PChar(EntryName(sr))) = 0 then
    begin
      if not IsExpanded(sr) then GetDirChildren(sr);
      Result:=sr;
      Break;
    end;
    sr := c.GetNextChild(sr);
  end;
end;
begin
  if Val = '' then raise Exception.Create(ahmrcstdInvalidPath);
  if Val = 'nil' then Exit;
  AddBSlash(Val);
  if not AHMShellItemExists(DelBSlash(Val)) then
  Val:=GetCurrentDir[1]+':\';
  if (not FNetwork) and (not(csDesigning in ComponentState)) and
     (GetDriveType(PChar(Val[1]+':\')) = Drive_Remote) then Val := fWinDir;
  az := AzPos(Val);
  if az = 0 then Exit;
  oldcur := Screen.Cursor;
  Screen.Cursor := crHourGlass;
  try
    Items.BeginUpdate;
    Val := UpperCase(Val);
    node := nil;
    for afg := 1 to az do
    begin
      tsr := GetPath(Val,afg);
      if afg = 1 then node := GetRoot(tsr)
                 else node := GetChi(node,tsr);
      if node = nil then Exit;
    end;
    Selected := node;
    TopItem := node;
  finally
    Items.EndUpdate;
    Screen.Cursor := oldcur;
  end;
end;

function TAHMExplorerTree.GetDirectory : String;
begin
  if Selected = nil then Result := 'nil' else
  try
    Result := EntryName(Selected);
  except
    Result := 'nil';
  end;
end;

function TAHMExplorerTree.AddKid (Par:TTreeNode; A : String):TTreeNode;
var sfi   : TSHFileInfo;
    item  : TTreeNode;
begin
  Result := nil;
  if Par = nil then Exit;
  AddBSlash(A);
  SHGetFileInfo(PChar(A),0,sfi,SizeOf(TSHFileInfo),SHGFI_SYSICONINDEX or SHGFI_SMALLICON
       or SHGFI_DISPLAYNAME);
  item := Par.Owner.AddChild(Par,sfi.szDisplayName);
  MakeTAHMDirectoryEntry(item,UpperCase(A),False);
  TreeGetImageIndex(item,sfi.iIcon);
  Result := item;
end;

procedure TAHMExplorerTree.AddNode(Var Item : TTreeNode; A : String);
var sfi   : TSHFileInfo;
begin
  AddBSlash(A);
  SHGetFileInfo(PChar(A),0,sfi,SizeOf(TSHFileInfo),SHGFI_SYSICONINDEX or SHGFI_SMALLICON
       or SHGFI_DISPLAYNAME);
  Item := Items.Add(nil,sfi.szDisplayName);
  MakeTAHMDirectoryEntry(item,UpperCase(A),False);
  TreeGetImageIndex(item,sfi.iIcon);
end;

procedure TAHMExplorerTree.GetSubKids (Par:TTreeNode);
var node : TTreeNode;
begin
  if csDesigning in ComponentState then Exit;
  if Par = nil then Exit;
  node := Par.GetFirstChild;
  while node <> nil do
  begin
    GetBtn(node);
    node := Par.GetNextChild(node);
  end;
end;

procedure TAHMExplorerTree.GetDirChildren (var Item:TTreeNode);
var sr      : TAHMDirectoryRecord;
    res,ct  : Integer;
    pt      : String;
    fDirs   : TStringList;
    E       : Integer;
begin
  if csDesigning in ComponentState then Exit;
  if Item = nil then Exit;
  if IsExpanded(Item) then Exit;
  fDirs := TStringList.Create;
  try
    pt := EntryName(Item);
    Item.DeleteChildren;
    PAHMDirectoryEntry(Item.Data)^.IsExp := True;
    FillChar(sr,SizeOf(TAHMDirectoryRecord),0);
    E := SetErrorMode(SEM_FAILCRITICALERRORS);
    try
      if Assigned(FOnFindDirectory) then FOnFindDirectory(Self,pt,res,True)
                              else res := FindFirstDir(pt+'*.*',sr);
      while res = 0 do
      begin
        if ((sr.Attr and faDirectory) > 0) and (sr.Name <> '.') and (sr.Name <> '..') then
        if AskAdd(pt+sr.Name+'\') then
        fDirs.Add(sr.Name);
        if Assigned(FOnFindDirectory) then FOnFindDirectory(Self,pt,res,False)
                                else res := FindNextDir(sr);
      end;
    finally
      SetErrorMode(E);
    end;
    Windows.FindClose(sr.Handle);
    fDirs.Sorted := True;
    if fDirs.Count > 0 then for ct := 0 to fDirs.Count -1 do AddKid(Item,pt+fDirs[ct]);
  finally
    FDirs.Free;
  end;
end;


procedure TAHMExplorerTree.GetBtn (var Item:TTreeNode);
var sr    : TAHMDirectoryRecord;
    res   : Integer;
    pt    : String;
    E     : Integer;
begin
  if csDesigning in ComponentState then Exit;
  if Item = nil then Exit;
  if IsExpanded(Item) then Exit;
  pt := EntryName(Item);
  E := SetErrorMode(SEM_FAILCRITICALERRORS);
  try
    if Assigned(FOnFindDirectory) then
    FOnFindDirectory(Self,pt,res,True)
  else
    res := FindFirstDir(pt+'*.*',sr);
    while res = 0 do begin
    if ((sr.Attr and faDirectory) > 0) and (sr.Name <> '.') and (sr.Name <> '..') then
    if AskAdd(pt+sr.Name+'\') then
    begin
      Items.AddChild(Item,'**');
      Break;
    end;
    if Assigned(FOnFindDirectory) then FOnFindDirectory(Self,pt,res,False)
                            else res := FindNextDir(sr);
  end;
  finally
    SetErrorMode(E);
  end;
  Windows.FindClose(sr.Handle);
end;


procedure TAHMExplorerTree.ReadNew;
var oldcur   : TCursor;
    node     : TTreeNode;
    ct       : Integer;
    drv      : Char;
    bits     : set of 0..25;
    E        : Integer;
function DriveExists(db:byte):Boolean;
var dr : Char;
    E  : Integer;
begin
  Result := False;
  if not (ct in bits) then Exit;
  dr := Char(db+Ord('A'));
  E := SetErrorMode(SEM_FAILCRITICALERRORS);
  try
    if not FNetwork then if GetDriveType(PChar(dr+':\')) = DRIVE_REMOTE then Exit;
    Result := True;
  finally
    SetErrorMode(E);
  end;
end;

begin
  if HandleAllocated then if not (csLoading in ComponentState) then
  begin
    fAllowChange := False;
    oldcur := Screen.Cursor;
    Screen.Cursor := crHourGlass;
    Items.BeginUpdate;
    ClearList;
    Application.ProcessMessages;
    E := SetErrorMode(SEM_FAILCRITICALERRORS);
    try
      Integer(bits):=GetLogicalDrives;
    finally
      SetErrorMode(E);
    end;
    for ct := 0 to 25 do
    if DriveExists(ct) then
    begin
      drv := Char (ct+Ord('A'));
      if AskAdd(drv+':\') then
      begin
        AddNode(node,drv+':\');
        if fFastLoad then Items.AddChild(node,'') else
        case GetDriveType(PChar(drv+':\')) of
          0,1,DRIVE_REMOVABLE,DRIVE_CDROM :Items.AddChild(node,'');
        else GetBtn(node);
      end;
    end;
  end;
  fAllowChange := True;
  Items.EndUpdate;
  TopItem := Selected;
  Screen.Cursor := oldcur;
  end;
end;

procedure TAHMExplorerTree.CreateWnd ;
begin
  inherited;
  ReadNew;
end;

function TAHMExplorerTree.CanExpand(Node: TTreeNode): Boolean ;
var oldcur : TCursor;
begin
  oldcur := Screen.Cursor;
  Screen.Cursor := crhourglass;
  GetDirChildren(Node);
  GetSubKids(Node);
  Screen.Cursor := oldcur;
  Result := inherited CanExpand(Node);
end;

procedure TAHMExplorerTree.Change(Node: TTreeNode);
var sr : String;
begin
  if not (csDestroying in ComponentState) then
  if fAllowChange then
  begin
    if Node <> nil then
    begin
      sr := UpperCase(EntryName(Node));
      try
        fActDirs[sr[1]] := sr;
      except
      end;
    end;
    inherited change (node);
  end;
end;

procedure TAHMExplorerTree.FullExpand;
var oldcur : TCursor;
    Node: TTreeNode;
begin
  oldcur := Screen.Cursor;
  Screen.Cursor := crHourGlass;
  Node := Items.GetFirstNode;
  while Node <> nil do
  begin
    Node.Expand(True);
    Node := Node.GetNextSibling;
  end;
  Screen.Cursor := oldcur;
end;

procedure TAHMExplorerTree.SetDrive (Val : Char);
var sr : String;
begin
  if UpCase(val) = UpCase (GetDirectory[1]) then Exit;
  try
    sr := fActDirs[UpCase(Val)];
    if not AHMShellItemExists(sr) then sr := Copy(sr,1,3);
    SetDirectory(sr);
  except
  end;
end;

function TAHMExplorerTree.GetDrive : Char;
begin
  Result := UpCase(GetDirectory[1]);
end;


function TAHMExplorerTree.GetNodeFromPath(Path : String):TTreeNode;
var az        : Integer;
    node      : TTreeNode;
    oldcur    : TCursor;
    afg       : Integer;
    tsr       : String;
function GNd(c:TTreeNode;a : String):TTreeNode;
var sr : TTreeNode;
begin
  Result := nil;
  if Items.Count = 0 then Exit;
  if c <> nil then sr := c.GetFirstChild
              else sr := Items[0];
  while sr <> nil do
  begin
    if EntryName(sr) = a then
    begin
      Result := sr;
      Exit;
    end;
    sr := sr.GetNextSibling;
  end;
end;

begin
  Result := nil;
  AddBSlash(Path);
  az := AzPos(Path);
  if az = 0 then Exit;
  oldcur := Screen.Cursor;
  Screen.Cursor := crHourGlass;
  Path := UpperCase(Path);
  node := nil;
  for afg := 1 to az do
  begin
    tsr := GetPath(Path,afg);
    node := GNd(node,tsr);
    if node = nil then
    begin
      Screen.Cursor := oldcur;
      Exit;
    end;
  end;
  Result := Node;
  Screen.Cursor := oldcur;
end;


procedure TAHMExplorerTree.DelItem (Sender: TObject; Node: TTreeNode);
begin
  if Node.Data <> nil then
  begin
    PAHMDirectoryEntry(Node.Data)^.Name := '';
    Dispose(PAHMDirectoryEntry(Node.Data));
    Node.Data := nil;
  end;
  if Assigned(FOnDeleteDirectory) then FOnDeleteDirectory(Sender,Node);
end;

procedure TAHMExplorerTree.RenamePath (OldPath,NewName : String);
var n : TTreeNode;
procedure RenameNodeAndKids(n:TTreeNode);
var sfi    : TSHFileInfo;
    oldsr  : String;
    n1     : TTreeNode;
begin
  oldsr := NewName+Copy(EntryName(n),Length(OldPath)+1,MaxInt);
  SHGetFileInfo(PChar(oldsr),0,sfi,SizeOf(TSHFileInfo),SHGFI_SYSICONINDEX or SHGFI_SMALLICON
       or SHGFI_DISPLAYNAME);
  n.Text := sfi.szDisplayName;
  PAHMDirectoryEntry(n.Data)^.Name := oldsr;
  TreeGetImageIndex(n,sfi.iIcon);
  if n = Selected then Change(n);
  if IsExpanded(n) and n.HasChildren then
  begin
    n1 := n.GetFirstChild;
    while n1 <> nil do
    begin
      RenameNodeAndKids(n1);
      n1 := n.GetNextChild(n1);
    end;
  end;
end;

begin
  if (NewName = '') or (OldPath = '') then Exit;
  n := GetNodeFromPath(OldPath);
  if n <> nil then
  begin
    OldPath := EntryName(n);
    NewName := ExtractFilePath(DelBSlash(OldPath))+NewName;
    AddBSlash(NewName);
    NewName := UpperCase(NewName);
    RenameNodeAndKids(n);
  end;
end;

procedure TAHMExplorerTree.DeletePath (DPath : String);
var n : TTreeNode;
begin
  n := GetNodeFromPath(DPath);
  if n <> nil then Items.Delete(n);
end;

procedure TAHMExplorerTree.AddPath(NewPath,NewSub : String);
var n,n1 : TTreeNode;
begin
  n := GetNodeFromPath(NewPath);
  if n <> nil then n1:=AddKid(n,EntryName(n)+NewSub);
  GetBtn(n1);
  n.AlphaSort;
end;

procedure TAHMExplorerTree.ClearNode (Node:TTreeNode);
begin
  if Node = nil then Exit;
  Node.DeleteChildren;
  PAHMDirectoryEntry(Node.Data)^.IsExp := False;
  GetBtn(Node);
end;

function TAHMExplorerTree.IsExpanded(Item : TTreeNode):Boolean;
begin
  Result := False;
  try
    if Item <> nil then
    if Assigned(Item.Data) then
      Result:=PAHMDirectoryEntry(Item.Data)^.IsExp;
  except
    Result := False;
  end;
end;

procedure TAHMExplorerTree.Loaded;
begin
  inherited Loaded;
  ReadNew;
  SetDirectory( GetDirectory );
end;

end.
