recursive directory tree
Thomas Kessels
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! ;-)
mc2...@spammclink.it
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
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;
>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.
Rob Morewood
:
: 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
|\| |ore...@south.sd41.bc.ca || Beautiful British Columbia
(Canada)
Hendrik T. Voelker
# When : 29.09.98
# Who : tkes...@bigfoot.com (Thomas Kessels)
# Where : /DE/COMP/LANG/PASCAL/MISC
# subject : recursive directory tree
# Reference : 36114863...@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 <basi...@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)
Rudolf Polzer
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 <tkes...@bigfoot.com> schrieb im Beitrag
<36114863...@news.tu-darmstadt.de>...
> 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]
Urs Strittmatter
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? ustrit...@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:
>
> 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 +++
Mason Ip
...
>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()?
Hendrik T. Voelker
# When : 05.10.98
# Who : einhar...@t-online.de (Rudolf Polzer)
# Where : /COMP/LANG/PASCAL/BORLAND
# Subject : Re: recursive directory tree
# Reference: 6vafok$p1r$4...@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.
Frank Peelo
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.
Hendrik T. Voelker
Hi folks,
mas...@attachmate.co_ (Mason Ip) wrote on 08.10.98 at
/COMP/LANG/PASCAL/BORLAND under the topic of "Re: recursive directory
tree" (MsgID: a87ce$9343...@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