Board index » delphi » recursive directory tree

recursive directory tree

Hi Folx!

I have problem with a routine converting a directory-tree to a list or
a
chain of pointers.

My procedure looks like this:

+++ cut here +++

procedure upDir(var source:string);
var test:string;
    s:searchrec;

begin
  findfirst(source+'\*.*', anyfile, s);         (* find first file *)
  if doserror=0 then
   if not ((s.name='.') or (s.name='..')) then  (* check if directory
*)
    if (s.attr=$10) then                                (* check if
directory *)
    begin
      test:=source+'\'+s.name;                  (* recurse procedure
*)
      updir(test);                                      (* recurse
procedure *)
(****************** Problem ******************)
    end
    else
    begin
        (* ADD PATH TO LIST *)
    end;
  while not (doserror=18) do                    (* if files left *)
  begin
    findnext(s);                                        (* find next
file *)
    if not ((s.name='.') or (s.name='..')) then (* check if directory
*)
    if (s.attr=$10) then                                (* check if
directory *)
    begin
      test:=source+'\'+s.name;                  (* recurse procedure
*)
      updir(test);                                      (* recurse
procedure *)
(****************** Problem ******************)
    end
    else
    begin
        (* ADD PATH TO LIST *)
    end;
  end;
end;

+++ cut here +++

My problem is marked with
"(****************** Problem ******************)"

At this point, the recursive sub-routine is finished, and the
procedure
should continue searching for files in the root-directory, but it
doesn't.
It just assumes that there are no more files in this directory and
closes.
So my list is correct until the first directory, and no further.

Example:
When I have this directory-tree:

c:\
    Test1 [DIR]
       Thomas.txt
       Thomas2.txt
    Test2 [DIR]
       Thomas3.txt
    Thomas4.txt

I should get this list:

  c:\test1\thomas.txt
  c:\test1\thomas2.txt
  c:\test2\thomas3.txt
  c:\thomas4.txt

Instead I get this:

  c:\test1\thomas.txt
  c:\test1\thomas2.txt

I already tried to set the doserror-variable to zero manually at the
end
of the procedure, but it didn't help - I just got a heap overflow
'cause
the program didn't terminate!

Ciao, Thomas

PS: Sorry for my english! ;-)

 

Re:recursive directory tree


I've shortened the routine and tried a Delphi version which works. I
haven't got a compiler to test the following, but I think it should work.

Ian

procedure upDir(var source:string);
var test:string;
    s:searchrec;

begin
  findfirst(source+'\*.*', anyfile, s);
  while not (doserror=18) then
    if not ((s.name='.') or (s.name='..')) then
    begin
      if (s.attr=$10) then
      begin
        test:=source+'\'+s.name;
        updir(test);    
      end
      else
      begin
        (* ADD PATH TO LIST *)
        Writeln(source+'\'+s.name);
      end;
    end;
    findnext(s);
  end;
end;

Quote
>PS: Sorry for my english! ;-)

Es tut mir leid: ich habe kein Deutsch. (Memories of high school.)
And you should hear my Italian.  )-;

Ian

Everything but the SPAM in the email address is ok.
------------------------------------------------------

If I knew where I was going, I'd probably be scared.

Re:recursive directory tree


Quote
Thomas Kessels (tkess...@bigfoot.com) wrote:

:
: I have problem with a routine converting a directory-tree to a list or
: a chain of pointers.
:
Here is something that does a very similar job and DOES work
(in Speed Pascal for OS/2 - it used to work with TPW 1.5
 but I don't remember if anything changed.)

Procedure ClearDir(Dir:DirectoryPointer);
{Delete all files not on the approved list.
 Recursively clear subdirectories.}
  Var Search : TSearchRec;
      FileName : String;
  Begin
    FileName:=Dir^.Name+'*.*';
    FindFirst(FileName,faAnyFile,Search);
    While DosError=0 do begin
      FileName:=Search.name;
      If Not((FileName='.') or (FileName='..')) then begin
        If Search.Attr AND faDirectory > 0 then
          ClearDir(DirSeek(Dir^.Name+FileName+'\',Dir))
        Else If FileSeek(FileName,Dir)=False then begin
          FileName:=Dir^.Name+FileName;
          SetFAttr(FileName,0);
          Erase(FileName);
          WriteLn('Deleted: ',FileName);
        end;
      end;
      FindNext(Search);
    end;
  end;

It looks like you want to make sure you check DOSERROR
immediately after each call to FindFirst or FindNext.
 _
|/|\/|                          ||   Maths & Computer Science
|\|  |orew...@south.sd41.bc.ca  ||  Beautiful British Columbia
                                            (Canada)

Re:recursive directory tree


                                                  October 1st, 1998

 # When      : 29.09.98
 # Who       : tkess...@bigfoot.com (Thomas Kessels)
 # Where     : /DE/COMP/LANG/PASCAL/MISC
 # subject   : recursive directory tree
 # Reference : 36114863.3915...@news.tu-darmstadt.de

 TK> I have problem with a routine converting a directory-tree to a list or
 TK> a chain of pointers.

 Yes, you have. The source of your annoyances is the DOSError. This ist
 _not_ a variable, but a function which returns the error code of the
 last system call. And using it is a destructive action, i.e. if you
 issue the DOSError-Call a second time rigth after the first call you
 will get a OK (0) every time.

 If you revise and tighten up your code, it may look like the following
 demo source:

 while you look at the code here some hints about ist:

 - (See mark 1) If use data that came from outside your function it is
   a very good idea to "import" them _all_ by using calling parameters
   rather than using global variables. This prevents sideeffects which
   are more than difficult to trace and find.

 - (See mark 2,3,6) The trick with complementary functions like
   FindFirst/FindNext is to do the call of FindNext at the _end_ of the
   while-loop. So the result of the call is checkt right away at the
   next iteration. This technic prevents the two loops, you have used.

 - (See mark 4) It is a good coding style to use constants in such
   comparations. If the names for the constants are choosen well, it
   will clearify the code without any comments :-)

 - (See mark 5) Because there can more attributes be set as just the
   Directory-Bit you have to explicitly test this bit rather than the
   value of the variable. And here, too, use symbolic constants.

 --- cut here ---
{$A+,B-,D+,E+,F-,G+,I+,L+,N-,O-,P-,Q+,R+,S+,T-,V-,X+,Y+}
{$M 16384,0,655360}

PROGRAM dl;

 {
   DirList

   A tiny program to demonstrate recursive traversal of disk-directories

   Copyright (c) 1998 Hendrik T. Voelker <basicb...@emcom.doo.donut.de>
 }

 USES
   Dos,
   Objects;

 CONST
   selfDir              = '.';
   rootDir              = '..';

   searchpattern        = '\*.*';

   erOK                 = 0;

 PROCEDURE updir
          ( searchpath  : STRING;
            dirlist     : PStringCollection );                   {1}

   VAR          { *updir* }
     sr                 : SearchRec;
     foundpath          : STRING;

   BEGIN        { *updir* }
     FindFirst (searchpath + searchpattern, AnyFile, sr);        {2}
     WHILE (DOSError = erOK) DO                                  {3}
       BEGIN
         IF NOT ((sr.name = selfDir) OR (sr.name = rootDir))     {4}
           THEN BEGIN
                  foundpath := searchpath + '\' + sr.name;
                  IF ((sr.attr AND Directory) <> 0)              {5}
                    THEN updir (foundpath, dirlist)
                    ELSE dirlist^.Insert (NewStr (foundpath));
                END;
         FindNext (sr);                                          {6}
       END;
   END;         { *updir* }

 PROCEDURE printdirlist
          ( dirlist     : PStringCollection );

   PROCEDURE printentry
            ( item      : Pointer );
            FAR;

     BEGIN      { *printdirlist.printentry* }
       WriteLn (PString (item)^);
     END;       { *printdirlist.printentry* }

   BEGIN        { *printdirlist* }
     dirlist^.ForEach (@printentry);
   END;         { *printdirlist* }

 VAR            { *MAIN* }
   dirlist              : PStringCollection;

 BEGIN          { *MAIN* }
   New (dirlist, init (20, 10));

   updir (ParamStr(1), dirlist);
   printdirlist (dirlist);

   Dispose (dirlist, done);
 END.           { *MAIN* }

 --- cut here ---

 I hope, it will help you.

 cu

 Hendrik
--
 "I am still confused, but on a higher level"
 (Prof. Dr. Patzelt to Uli, after Uli had explained his program for the
  second time)

Re:recursive directory tree


doserror is only valid after a findfirst or findnext.

Try this:

type AddProc = procedure (s: string);

procedure RecurseDirs (path: string; Add: AddProc);
var s: searchrec;
begin
        findfirst (path + '*.*', AnyFile, s);
        while doserror <> 18 do begin
                if s.Attr and Directory <> 0 then
                        if (s.Name <> '.') and (s.Name <> '..') then begin
                                RecurseDirs (path + s.Name + '\', Add);
                                Add (path + s.Name + '\')
                        end
                else Add (path + s.Name);
                findnext (s)
        end
end;

Thomas Kessels <tkess...@bigfoot.com> schrieb im Beitrag
<36114863.3915...@news.tu-darmstadt.de>...

Quote
> Hi Folx!

> I have problem with a routine converting a directory-tree to a list or
> a
> chain of pointers.

> My procedure looks like this:

[snip]

> My problem is marked with
> "(****************** Problem ******************)"

> At this point, the recursive sub-routine is finished, and the
> procedure
> should continue searching for files in the root-directory, but it
> doesn't.
> It just assumes that there are no more files in this directory and
> closes.
> So my list is correct until the first directory, and no further.

> Example:
> When I have this directory-tree:

> c:\
>     Test1 [DIR]
>        Thomas.txt
>        Thomas2.txt
>     Test2 [DIR]
>        Thomas3.txt
>     Thomas4.txt

> I should get this list:

>   c:\test1\thomas.txt
>   c:\test1\thomas2.txt
>   c:\test2\thomas3.txt
>   c:\thomas4.txt

> Instead I get this:

>   c:\test1\thomas.txt
>   c:\test1\thomas2.txt

> I already tried to set the doserror-variable to zero manually at the
> end
> of the procedure, but it didn't help - I just got a heap overflow
> 'cause
> the program didn't terminate!

> Ciao, Thomas

> PS: Sorry for my english! ;-)

Re:recursive directory tree


Solution for the recursive directory tree problem.

In brief: DOSEEROR is global variable . So, after the first recursion
step this variable keeps 18. See the bugfixed program posted here (after
the german section ;-))

"Next five" statements in german!

Hallo Thomas,

Dir ist ein klassischer Seiten-Effekt Fehler unterlaufen. Die DOS
Variable Doserror ist global (vor-) definiert. Dadurch wird nach der
ersten Rekursion abgebrochen. While doserror <> 18 ... Doserror ist aber
nach der Rueckkehr aus der ersten Rekursion noch auf 18 gesetzt.

Ich habe einfach eine neue (lokale) variable derror eingefuehrt, die
nach jedem Aufruf von findnext auf den Wert von doserror gesetzt wird.
So hat jede Rekursionsstufe ihre "eigene" errorvariable. Deine While
Schleife (meine Repeat) fragt nun nach derror ab. (Mit while gehts
natuerlich auch)

Die Abfrage beim WriteLn nach derror 18 muss (in dieser Version) sein,
da sonst der allerletzte Verzeichniseintrag verdoppelt ausgegeben wird.
Das geht aber bestimmt auch eleganter ;-) Dazu hatte ich aber keine Lust
mehr.

bye: urs

PS: Im oberen Teil Deines Programmes sind viele Programmteile, die nie
erreicht werden. Zumindest nicht, wenn Du vorhast immer nach *.* zu
suchen. Der erste Eintrag in einem (vorhandenen) Verzeichnis ist immer
ein directory (.).

Melde Dich doch mal, wenn's klappt, OK? ustrittmat...@airplus.de,
www.airplus.de, www.bunko.net,

aber vor allem: See: www.rz.uni-frankfurt.de/~raisig/katbp.html

Hier mein Programmvorschlag

program dirrek;
uses crt, dos;
var dir : String;

procedure upDir(var source:string);
var test:string;
    s:searchrec;
################ New new New new New #################################
    derror : Integer;
################ New new New new New #################################
begin
  findfirst(source+'\*.*', anyfile, s);         (* find first file *)
  if doserror=0 then
    if not ((s.name='.') or (s.name='..')) then  (* check if directory
*)
     if (s.attr=$10) then                        (* check if directory
*)
     begin
       test:=source+'\'+s.name;                  (* recurse procedure *)
       updir(test);                                      (* recurse
procedure *)
 (****************** No Problem anymore ******************)
     end
     else
     begin
       WriteLn(source,'\',s.name,' ');
         (* ADD PATH TO LIST *)
     end;
  repeat
                    (* if files left *)

    findnext(s);                                        (* find next
file *)
################ New new New new New #################################
    derror := doserror;    (* derror for every recursion step *)

################ New new New new New #################################
setzten*)
    if not ((s.name='.') or (s.name='..')) then (* check if directory *)
    if (s.attr=$10) then                                (* check if
directory *)
    begin
      test:=source+'\'+s.name;                  (* recurse procedure *)
      updir(test);                                      (* recurse
procedure *)
(****************** No Problem anymore ******************)
    end
    else
    begin
################ New new New new New #################################
      if (derror <> 18) then WriteLn(source,'\',s.name,' ');
      (* if derror... -> otherwise the last scanned file is listed twice
*)
################ New new New new New #################################
        (* ADD PATH TO LIST *)
    end
  until derror=18;

end;

begin
  clrscr;
  dir := 'c:\ursel';
  updir (dir);
end.

Thomas Kessels schrieb:

Quote

> Hi Folx!

> I have problem with a routine converting a directory-tree to a list or
> a
> chain of pointers.

> My procedure looks like this:

> +++ cut here +++
> +++ cut here +++

> My problem is marked with
> "(****************** Problem ******************)"

> At this point, the recursive sub-routine is finished, and the
> procedure
> should continue searching for files in the root-directory, but it
> doesn't.
> It just assumes that there are no more files in this directory and
> closes.
> So my list is correct until the first directory, and no further.

> Example:
> When I have this directory-tree:

> c:\
>     Test1 [DIR]
>        Thomas.txt
>        Thomas2.txt
>     Test2 [DIR]
>        Thomas3.txt
>     Thomas4.txt

> I should get this list:

>   c:\test1\thomas.txt
>   c:\test1\thomas2.txt
>   c:\test2\thomas3.txt
>   c:\thomas4.txt

> Instead I get this:

>   c:\test1\thomas.txt
>   c:\test1\thomas2.txt

> I already tried to set the doserror-variable to zero manually at the
> end
> of the procedure, but it didn't help - I just got a heap overflow
> 'cause
> the program didn't terminate!

> Ciao, Thomas

> PS: Sorry for my english! ;-)

Re:recursive directory tree


Quote
Rudolf Polzer wrote...

...

Quote
>type AddProc = procedure (s: string);

>procedure RecurseDirs (path: string; Add: AddProc);
>var s: searchrec;
>begin
>        findfirst (path + '*.*', AnyFile, s);
>        while doserror <> 18 do begin
>                if s.Attr and Directory <> 0 then
>                        if (s.Name <> '.') and (s.Name <> '..') then begin
>                                RecurseDirs (path + s.Name + '\', Add);
>                                Add (path + s.Name + '\')
>                        end
>                else Add (path + s.Name);
>                findnext (s)
>        end
>end;

For the sake of simplicity, let say, procedure Add was defined below:

procedure add (s : string);
begin
  writeln (s);
end;

I tried to call RecurseDirs as below:

d:\tp7>bin\tpc lspath.pas
Turbo Pascal  Version 7.0  Copyright (c) 1983,92 Borland International
LSPATH.PAS(30): Error 143: Invalid procedure or function reference.
  RecurseDirs (s, Add);
                     ^
d:\tp7>

How should I call RecurseDirs()?

Re:recursive directory tree


                                                 08.10.98

 # When     : 05.10.98
 # Who      : einhardsch...@t-online.de (Rudolf Polzer)
 # Where    : /COMP/LANG/PASCAL/BORLAND
 # Subject  : Re: recursive directory tree
 # Reference: 6vafok$p1...@news00.btx.dtag.de

 RP>         findfirst (path + '*.*', AnyFile, s);
 RP>         while doserror <> 18 do begin
              ^^^^^^^^^^^^^^
 RP>                 findnext (s)
 RP>         end

 The testing, if DOSError is not equal 18 is no good idea. The
 FirndFirst / FindNext calls can produce other errorcode different fom
 zero (OK), e.g. error code 2 "dir not found". A testing for 0 is a much
 better solution.

        findfirst (path + '*.*', AnyFile, s);
        while doserror = 0 do begin
                findnext (s)
        end;

 cu

 Hendrik
--
 Get Revenge! Live long enough to be a problem for your children.

Re:recursive directory tree


Quote
Mason Ip wrote in message ...
>...
>procedure add (s : string);
>begin
>...
>LSPATH.PAS(30): Error 143: Invalid procedure or function reference.
>  RecurseDirs (s, Add);

It should have been
procedure add (s : string); Far;
begin...

or the compiler option {$F+} should have been set, which has the same
effect.

Re:recursive directory tree


                                                 10 Oct 98

 Hi folks,

 maso...@attachmate.co_ (Mason Ip)  wrote on 08.10.98 at
 /COMP/LANG/PASCAL/BORLAND under the topic of "Re: recursive directory
 tree" (MsgID: a87ce$93430....@news.kea.bc.ca)

 MI> For the sake of simplicity, let say, procedure Add was defined below:
 MI> procedure add (s : string);
 MI>
 MI> LSPATH.PAS(30): Error 143: Invalid procedure or function reference.
 MI>   RecurseDirs (s, Add);
 MI>
 MI> How should I call RecurseDirs()?

 :-) The problem is the reference to procedure add: ist is a near
 reference. But it has to be a far recerence, so add the "far" keyword
 to the procedure definition, and it will compile correctly.

 PROCEDURE add
          ( s           : STRING);
          FAR;                          <---- you have to add this line!

 cu

 Hendrik
--
 NEVER run a changing System

Re:recursive directory tree


                                                 10 Oct 98

 Hi folks,

 maso...@attachmate.co_ (Mason Ip)  wrote on 08.10.98 at
 /COMP/LANG/PASCAL/BORLAND under the topic of "Re: recursive directory
 tree" (MsgID: a87ce$93430....@news.kea.bc.ca)

 MI> For the sake of simplicity, let say, procedure Add was defined below:
 MI> procedure add (s : string);
 MI>
 MI> LSPATH.PAS(30): Error 143: Invalid procedure or function reference.
 MI>   RecurseDirs (s, Add);
 MI>
 MI> How should I call RecurseDirs()?

 :-) The problem is the reference to procedure add: ist is a near
 reference. But it has to be a far recerence, so add the "far" keyword
 to the procedure definition, and it will compile correctly.

 PROCEDURE add
          ( s           : STRING);
          FAR;                          <---- you have to add this line!

 cu

 Hendrik
--
 NEVER run a changing System

Other Threads