We help IT Professionals succeed at work.

tree walking utility

fibdev
fibdev asked
on
Hello,

I'm trying to write a console application that accepts a directory as a parameter and recursivly lists all the files and folders in the tree until it reaches the end.  Basiclly I'm trying to recreate the tree.com file used by some versions of windows.

Gabe
Comment
Watch Question

Commented:
Read this article:
http://www.delphi-jedi.org/Jedi:VOY_USINGTREEVIEWS:83777

TreeViews basics

By Kevin S. Gallagher

Download article & projects

One of the least used components in Delphi is the TreeView control. When properly used the TreeView can make a big difference in how well someone can utilize your application. One good reason for using a TreeView is, humans identify with graphics much better then with text. Just looks at road signs, at least for me the color and shape of a sign triggers a response prior to reading the text on the sign. One significant aspect of a TreeView is that each branch item (node) can be represented with an image. Example, Microsoft Explorer uses different images for open and closed folder(s), see example below.

Best Regards

Cesario
SILVER EXPERT

Commented:
hello fibdey, You can use FindFirst() to get folders and files, then just use WriteLn() to output each folder or file. Here is some code from a console app that will list the files in the folder and subfolders, It does not list them in a "Tree" look, but just lists them. You can add spaces or ........ to get a tree look.


program unins;
{$APPTYPE CONSOLE}
uses
  Windows, Messages, SysUtils;

var
What1, Folder1: String;

procedure DirList( src : String ) ;
var
  sts : Integer ;
  SR: TSearchRec;
begin
  sts := FindFirst( src + '*.*' , faDirectory + faHidden + faSysFile , SR ) ;
  if sts = 0 then
  begin
    if ( SR.Name <> '.' ) and ( SR.Name <> '..' ) then
    begin
      if SR.Attr = faDirectory then
      begin
          DirList( src + SR.Name + '\' ) ;
 
      end else
         WriteLn(Folder1 + SR.Name);
    end ;
    while FindNext( SR ) = 0 do
    if ( SR.Name <> '.' ) and ( SR.Name <> '..' ) then
    begin
      if SR.Attr = faDirectory then
      begin
        DirList( src + SR.Name + '\' ) ;

      end
      else
         WriteLn(Folder1 + SR.Name);
    end ;
    FindClose( SR ) ;
  end ;
end ;

procedure StartDirList(Dir: String);
var
  sts : Integer ;
  SR: TSearchRec;
  Folder1: String;
begin
if Dir[Length(Dir)] <> '\'  then
    Dir := Dir+'\';
Folder1 := Dir;
sts := FindFirst( Folder1+'*.*' , faDirectory  , SR ) ;
  if sts = 0 then
  begin // sts =0
    if ( SR.Name <> '.' ) and ( SR.Name <> '..' ) then
    begin
      if SR.Attr = faDirectory then
      begin
          DirList( Folder1 + SR.Name + '\' ) ;

      end
      else
        WriteLn(Folder1 + SR.Name);
    end ;
    while FindNext( SR ) = 0 do
    if ( SR.Name <> '.' ) and ( SR.Name <> '..' ) then
    begin
      if SR.Attr = faDirectory then
      begin
        DirList( Folder1 + SR.Name + '\' ) ;

      end
      else
         WriteLn(Folder1 + SR.Name);
    end ;
    FindClose( SR ) ;
  end ;
end;

begin
Writeln('This will list all files in the folders');
Writeln('Enter the Folder Path');
ReadLn(What1);
StartDirList(What1);
What1 := '';

Writeln('');
Writeln('Thats all the files);
ReadLn(What1);
end.

- - - - - - - - - - - - - - - - - - - -
ask questions if you need info, let me know

Author

Commented:
Slick812,

Can you help me customize this to suit my needs?

I need to add spaces or something to give a graphical representation of a new folder.  Thanks to you, I'm so close to what I'm looking for.

Gabe

Author

Commented:
Also,

I want to pass ParamStr(1) as the directory path.

Gabe
SILVER EXPERT

Commented:
do you have much experience with Console apps? ? Or with console API using StandardBuffer handles? I may have some time tommorow to mess with this.
SILVER EXPERT

Commented:
Oh, why do you want this to be a console app? File size maybe? What is this to be used for? Listing files and folders in a limited space, non graphical console seems like a waste of time to me. Who would use this? Do you want the command line /f like the DOS TREE.COM, and maybe a /p to list one screen at a time since you can not use | more ?

Author

Commented:
It's going to be distributed with a bundle of shell extentions I'm working on.
SILVER EXPERT

Commented:
shell extentions? Shouldn't shell extention be in GUI instead of Console? Unless they are for DOS6 fans. I tried some things to get it "to give a graphical representation of a new folder", using spaces and hyphens, but the limited space of a console ASCI output is not good for this at all. I did not have time to get it to do a Tree View for folders. Folders on my computer can go 20 or 30 folders deep, with more than 200 files in a folder. If you miss a file on the first screen output, you CAN NOT scroll back to it. If you are only interested in one sub folder it will display ALL Files in all folders. You did not say anything about why You want a command line. You can make Forms that take command line input AND give a usable TreeView of a Folder. As for you question "I want to pass ParamStr(1) as the directory path."

DirList( ParamStr(1) );

Except for folders with less than 20 files and less than 5 subfolders with NO subfolders and very few files, this doesn't seem like the way to go. ? ?

Author

Commented:
The reason I'm using a concole app for this is because the results will be printed to a text file or printer.  I have no need for a gui on this project.

Gabe :)
SILVER EXPERT
Commented:
OK, here's what I have, It will list all folders and files and have a tree arangement, but the folder depth for tree arrangement is just 2 or 3. I don't have time right now to do more, but this should be more than enough for you to get the folder depth thing too. You may consider using stringLists or something for the Folders and then keep track of the folder depth by which string list you are working with. Or experiment with counting the cycles of DirList. I tried to use some text colors for folder and file differenciation. There are some things I tried like "procedure NumDir;" which did not work out, I left them in there as comments.



program Tree;
{$APPTYPE CONSOLE}
uses
  Windows, SysUtils;

var
Input1, PreStr, EndStr: String;
hStdOut, Depth, LineNum{, DirNum, Cycle}: Integer;
ScreenBufInfo: TConsoleScreenBufferInfo;

const
Space = '   ';

procedure TestLine;
begin
Inc(lineNum);
if LineNum = ScreenBufInfo.dwSize.Y-3 then
  begin
  SetConsoleTextAttribute(hStdOut,FOREGROUND_GREEN or FOREGROUND_RED or FOREGROUND_BLUE);
  WriteLn('press Enter for more');
  ReadLn(Input1);
  LineNum := 0;
  end;
end;

procedure ListFiles(Dir2: String);
var
{PreStr: String;}
SearchRec: TSearchRec;
{i: Integer;}
begin
if FindFirst( Dir2 + '*.*' , faHidden + faSysFile , SearchRec ) = 0 then
   begin
   Write(PreStr);
   SetConsoleTextAttribute(hStdOut,BACKGROUND_GREEN or BACKGROUND_RED or BACKGROUND_BLUE);
   Write(SearchRec.Name);
   SetConsoleTextAttribute(hStdOut,FOREGROUND_GREEN or FOREGROUND_RED or FOREGROUND_BLUE);
   WriteLn('');
   TestLine;
   while FindNext( SearchRec ) = 0 do
     begin
     Write(PreStr);
     SetConsoleTextAttribute(hStdOut,BACKGROUND_GREEN or BACKGROUND_RED or BACKGROUND_BLUE);
     Write(SearchRec.Name);
     SetConsoleTextAttribute(hStdOut,FOREGROUND_GREEN or FOREGROUND_RED or FOREGROUND_BLUE);
     WriteLn('');
     TestLine;
     end;
   end;
FindClose(SearchRec);

end;

procedure DirList( Dir1 : String ) ;
var
  SearchRec: TSearchRec;
  i: Integer;

  {procedure NumDir;
  begin
  if FindFirst( Dir1 + '*.*' , faDirectory + faHidden  , SearchRec )
   = 0 then
    begin
    if ( SearchRec.Name <> '.' ) and ( SearchRec.Name <> '..' ) then
      if SearchRec.Attr = faDirectory then
      Inc(DirNum);
      while FindNext( SearchRec ) = 0 do
        if ( SearchRec.Name <> '.' ) and ( SearchRec.Name <> '..' ) then
          if SearchRec.Attr = faDirectory then
          Inc(DirNum);
    end;
  end;}

begin
PreStr := '';
for i := 0 to Depth do
PreStr := PreStr+Space;
  if FindFirst( Dir1 + '*.*' , faDirectory + faHidden  , SearchRec )
   = 0 then
  begin
    if ( SearchRec.Name <> '.' ) and ( SearchRec.Name <> '..' ) then
    begin
      if SearchRec.Attr = faDirectory then
      begin
      Write(PreStr);
      SetConsoleTextAttribute(hStdOut,FOREGROUND_GREEN or FOREGROUND_RED or FOREGROUND_INTENSITY);
      WriteLn(SearchRec.Name);
      SetConsoleTextAttribute(hStdOut,FOREGROUND_GREEN or FOREGROUND_RED or FOREGROUND_BLUE);
      TestLine;
      ListFiles(Dir1 + SearchRec.Name + '\' );
      DirList( Dir1 + SearchRec.Name + '\' ) ;
      end;
    end ;
    while FindNext( SearchRec ) = 0 do
    if ( SearchRec.Name <> '.' ) and ( SearchRec.Name <> '..' ) then
    begin
      if SearchRec.Attr = faDirectory then
      begin
      Write(PreStr);
      SetConsoleTextAttribute(hStdOut,FOREGROUND_GREEN or FOREGROUND_RED or FOREGROUND_INTENSITY);
      WriteLn(SearchRec.Name);
      SetConsoleTextAttribute(hStdOut,FOREGROUND_GREEN or FOREGROUND_RED or FOREGROUND_BLUE);
      TestLine;
      ListFiles(Dir1 + SearchRec.Name + '\' );
      DirList( Dir1 + SearchRec.Name + '\' ) ;
      end;
    end ;

  end ;
FindClose( SearchRec ) ;
{Inc(Cycle);
if Cycle = DirNum then
Inc(Depth);}
{WriteLn('Depth is '+IntToStr(Depth));}

end ;


procedure StartDirList(Dir: String);
var
  SearchRec: TSearchRec;
begin
Depth := 0;
if Dir[Length(Dir)] <> '\'  then
    Dir := Dir+'\';
WriteLn('');
SetConsoleTextAttribute(hStdOut,FOREGROUND_GREEN or FOREGROUND_RED or FOREGROUND_INTENSITY);
WriteLn(Dir);
SetConsoleTextAttribute(hStdOut,FOREGROUND_GREEN or FOREGROUND_RED or FOREGROUND_BLUE);
ListFiles(Dir);
if FindFirst( Dir+'*.*' , faDirectory  , SearchRec )
   = 0 then
  begin
    if ( SearchRec.Name <> '.' ) and ( SearchRec.Name <> '..' ) then
    begin
      if SearchRec.Attr = faDirectory then
      begin
      Depth := 1;
      Write(Space);
      SetConsoleTextAttribute(hStdOut,FOREGROUND_GREEN or FOREGROUND_RED or FOREGROUND_INTENSITY);
      WriteLn(SearchRec.Name);
      SetConsoleTextAttribute(hStdOut,FOREGROUND_GREEN or FOREGROUND_RED or FOREGROUND_BLUE);
      TestLine;
      PreStr := Space;
      ListFiles(Dir + SearchRec.Name + '\');
      {Cycle := 0;
      DirNum := 0; }
      DirList( Dir + SearchRec.Name + '\' ) ;
      end;
    end ;
    while FindNext( SearchRec ) = 0 do
    if ( SearchRec.Name <> '.' ) and ( SearchRec.Name <> '..' ) then
    begin
      if SearchRec.Attr = faDirectory then
      begin
      Depth := 1;
      {Cycle := 0;
      DirNum := 0;}
      Write(Space);
      SetConsoleTextAttribute(hStdOut,FOREGROUND_GREEN or FOREGROUND_RED or FOREGROUND_INTENSITY);
      WriteLn(SearchRec.Name);
      SetConsoleTextAttribute(hStdOut,FOREGROUND_GREEN or FOREGROUND_RED or FOREGROUND_BLUE);
      TestLine;
      PreStr := Space;
      ListFiles(Dir + SearchRec.Name + '\');
      Inc(Depth);
      DirList( Dir + SearchRec.Name + '\' ) ;

      end;

    end ;
  end else
  EndStr := 'Invalid Folder Path, press Enter to Exit';
FindClose( SearchRec ) ;
end;

begin
PreStr:= '';
EndStr := 'That''s all the Folders and Files, press Enter to exit';
hStdOut := GetStdHandle(STD_OUTPUT_HANDLE);
GetConsoleScreenBufferInfo(hStdOut, ScreenBufInfo);
if ParamStr(1) <> '' then
StartDirList( ParamStr(1) )
else
  begin
  Writeln('This will list subfolders and files');
  Writeln('Enter Folder path');
  ReadLn(Input1);
  StartDirList( Input1 );
  end;
Writeln('');
SetConsoleTextAttribute(hStdOut,FOREGROUND_RED or FOREGROUND_INTENSITY);
Writeln(EndStr);
ReadLn(Input1);
Input1 := '';
end.


 - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

hope this gets it going for ya.

Author

Commented:
Slick,

Thanks for getting this started for me.  It looks like you put quite a bit of work into it.  More than I expected.

Gabe
SILVER EXPERT

Commented:
This may be to late, but here it is. I did not like the console for this, and you did not mention anything about printing, here is a app that prints this folder list.


program PrintTree;

uses
  Windows, SysUtils, Classes, Printers;

{$R *.RES}

var
PreStr: String;
FolderList: TStringList;
TH, i: Integer;
HaveList: Boolean;

const
Space = '    ';

procedure ListFiles(Dir2: String);
var
SearchRec: TSearchRec;
begin
if FindFirst( Dir2 + '*.*' , faHidden + faSysFile , SearchRec ) = 0 then
   begin
   FolderList.Add(PreStr+SearchRec.Name);
   while FindNext( SearchRec ) = 0 do
     begin
     FolderList.Add(PreStr+SearchRec.Name);
     end;
   end;
FindClose(SearchRec);

end;

procedure DirList( Dir1 : String ) ;
var
  SearchRec: TSearchRec;

  function DepthStr(Directory: String): String;
  var
  Num, i: Integer;
  S: String;
  begin
  Num := 1;
  S := Directory;
  while Pos('\', S) > 0 do
    begin
    S[Pos('\', S)] := 'M';
    Inc(Num);
    end;
  PreStr:= '';
  for i := 0 to Num-4 do
      PreStr := PreStr+Space;
  Result := PreStr;
  end;

begin
  if FindFirst( Dir1 + '*.*' , faDirectory + faHidden  , SearchRec )
   = 0 then
  begin
    if ( SearchRec.Name <> '.' ) and ( SearchRec.Name <> '..' ) then
    begin
      if SearchRec.Attr = faDirectory then
      begin
      FolderList.Add(DepthStr(Dir1)+SearchRec.Name);
      ListFiles(Dir1 + SearchRec.Name + '\' );
      DirList( Dir1 + SearchRec.Name + '\' ) ;
      end;
    end ;
    while FindNext( SearchRec ) = 0 do
    if ( SearchRec.Name <> '.' ) and ( SearchRec.Name <> '..' ) then
    begin
      if SearchRec.Attr = faDirectory then
      begin
      FolderList.Add(DepthStr(Dir1)+SearchRec.Name);
      ListFiles(Dir1 + SearchRec.Name + '\' );
      DirList( Dir1 + SearchRec.Name + '\' ) ;
      end;
    end ;

  end ;
FindClose( SearchRec ) ;
end ;


procedure StartDirList(Dir: String);
var
  SearchRec: TSearchRec;
begin
if Dir[Length(Dir)] <> '\'  then
    Dir := Dir+'\';
FolderList.Add('');
FolderList.Add(Dir);
PreStr := ' ';
ListFiles(Dir);
if FindFirst( Dir+'*.*' , faDirectory  , SearchRec )
   = 0 then
  begin
    if ( SearchRec.Name <> '.' ) and ( SearchRec.Name <> '..' ) then
    begin
      if SearchRec.Attr = faDirectory then
      begin
      FolderList.Add(Space+SearchRec.Name);
      PreStr := Space;
      ListFiles(Dir + SearchRec.Name + '\');
      DirList( Dir + SearchRec.Name + '\' ) ;
      end;
    end ;
    while FindNext( SearchRec ) = 0 do
    if ( SearchRec.Name <> '.' ) and ( SearchRec.Name <> '..' ) then
    begin
      if SearchRec.Attr = faDirectory then
      begin
      FolderList.Add(Space+SearchRec.Name);
      PreStr := Space;
      ListFiles(Dir + SearchRec.Name + '\');
      DirList( Dir + SearchRec.Name + '\' ) ;

      end;

    end ;
  end else HaveList := False;
  {EndStr := 'Invalid Folder Path, press Enter to Exit';}
FindClose( SearchRec ) ;
end;

begin  //  main Program begin - - - - - - -  -- - - - - - - -
FolderList := TStringList.Create;
HaveList := True;
if ParamStr(1) <> '' then
StartDirList( ParamStr(1) ) else
StartDirList( 'C:\Stuff\Temp\' );
if HaveList then
if MessageBox(0,'Do you want to print this Folder List?'#13'Is the Printer Ready?','Print Folder list?', MB_YESNO or MB_ICONQUESTION ) = ID_YES then
begin
Printer.Title := 'Folder List';
Printer.BeginDoc;
Printer.Canvas.Font.Name := 'Arial';
Printer.Canvas.Font.Size := 12;
TH := Printer.Canvas.TextHeight('M');
{Printer.Canvas.TextOut(15,TH,FolderList[0]);}
for i:= 0 to FolderList.Count-1 do
  Printer.Canvas.TextOut(38, (TH*i+1)+5, FolderList[i]);
Printer.EndDoc;
end
else
FolderList.SaveToFile('C:Stuff\Temp\Folder list.txt');
FolderList.Free;
end.


 - - - - - - - - - - - - - - - - - -  --

I hope you get to see it

Author

Commented:
Thanks slick, I'll look at it...

Explore More ContentExplore courses, solutions, and other research materials related to this topic.