home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / bix / walktree.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-11-01  |  4.9 KB  |  183 lines
  1. {TITLE: TREE-WALKING PROGRAM
  2.     I'd asked (in pascal/turbo #1671) about a code fragment to walk the DOS 
  3. directory tree.  I got several suggestions, but no program, so I write one, 
  4. and here it is.  Thanks to those who helped!
  5. }
  6. (*************************************************************************)
  7.  
  8. PROGRAM WalkDirectoryTree;
  9. {$p256,g256}
  10.  
  11. { This program uses recursion and DOS calls to "walk" the DOS subdirectory
  12.   tree.  Beginning at some starting directory, it returns the name of every
  13.   subdirectory and file in the tree structure.
  14.  
  15.   It is, of course, not good for anything by itself, but may be a valuable
  16.   component of a SWEEP program or other utility.  All dire warnings apply.
  17.  
  18.   Thanks to JimKeo, who provided the DOS function call code (see pascal/
  19.   source #7) which make up the bulk of the program, and to DNanian, who 
  20.   reminded me that Pascal supports recursion.  
  21.  
  22.                                                      --Bob Brown
  23.                                                        September, 1986
  24. }
  25.  
  26. TYPE
  27.   AnyString =      STRING[255];
  28.   PathString=      STRING[64];
  29.   FileString=      STRING[12];
  30.   Regset =         RECORD
  31.                      CASE INTEGER OF
  32.                       0: (ax,bx,cx,dx,bp,si,di,ds,es,flags:INTEGER);
  33.                       1: (al,ah,bl,bh,cl,ch,dl,dh:BYTE);
  34.                    END;
  35.   FileInfo=        RECORD
  36.                      FindInfo: ARRAY[1..21] OF BYTE;
  37.                      Attr: BYTE;
  38.                      Time, Date, SizeLo, SizeHi: INTEGER;
  39.                      FileName: ARRAY[0..12] of CHAR;
  40.                    END;
  41.   DTAPtr =         ^FileInfo;
  42. VAR
  43.   CurrentPath:     PathString;
  44.  
  45. PROCEDURE GetDTA(VAR p);                         {from JimKeo}
  46. VAR
  47.   Regs:  RegSet;
  48.   PP:    ^FileInfo ABSOLUTE p;
  49. BEGIN {GetDTA}
  50.   Regs.ah := $2f;
  51.   MsDOS(Regs);
  52.   PP := ptr(Regs.es, Regs.bx);
  53. END;
  54.  
  55. PROCEDURE SetDTA(P:DTAPtr);                      {from JimKeo}
  56. VAR
  57.   Regs:  RegSet;
  58. BEGIN {SetDTA}
  59.   Regs.ah := $1a;
  60.   Regs.ds := SEG(P^);
  61.   Regs.dx := OFS(P^);
  62.  
  63.   MsDOS(Regs);
  64. END; {SetDTA}
  65.  
  66. FUNCTION AsciiZ2S(VAR AsciiZ):AnyString;          {from JimKeo}
  67. VAR
  68.   A:           ARRAY[0..255] OF CHAR ABSOLUTE AsciiZ;
  69.   I:           INTEGER;
  70.   S:           AnyString;
  71.   BEGIN
  72.     I := 0;
  73.     WHILE A[I] <> CHR(0) DO
  74.       I := SUCC(I);
  75.     {$R-}
  76.     S[0] := CHR(I);
  77.     MOVE (A,S[1],I);
  78.     {$R+}
  79.     AsciiZ2S := S;
  80.   END; {AsciiZ2S}
  81.  
  82. FUNCTION FindFirst(Name:PathString; Attr:INTEGER; VAR info:FileInfo):BOOLEAN;
  83. VAR                                              {from JimKeo}
  84.   Regs:  RegSet;
  85.   Save:  ^FileInfo;
  86. BEGIN {FindFirst}
  87.   GetDTA(Save);
  88.   SetDTA(addr(info));
  89.   Regs.ah := $4E;
  90.   Regs.ds := seg(Name);
  91.   Regs.dx := ofs(Name)+1;                   {+1 to get past length byte}
  92.   Name := Name + #0;
  93.   Regs.cx := Attr;
  94.   MsDos(Regs);
  95.   FindFirst := (Regs.flags AND $01) = 0;
  96.   SetDTA (Save);
  97. END; {FindFirst}
  98.  
  99. FUNCTION FindNext(VAR info:FileInfo):BOOLEAN;       {from JimKeo}
  100. VAR
  101.   Regs:  RegSet;
  102.   Save:  ^FileInfo;
  103. BEGIN;
  104.   GetDTA(Save);
  105.   SetDTA(addr(info));
  106.   Regs.ah := $4f;
  107.   MsDos(Regs);
  108.   FindNext := (Regs.Flags AND $01) = 0;
  109.   SetDTA(Save);
  110. END;
  111.  
  112. FUNCTION DosVersion: INTEGER;          {from JimKeo}
  113. VAR
  114.   Regs: RegSet;
  115. BEGIN {DosVersion}
  116.   Regs.ah := $30;
  117.   MSDos(Regs);
  118.   DosVersion := Regs.al*100+Regs.ah;
  119. END;
  120.  
  121. FUNCTION FullFileName (PathName:PathString; FileName:FileString):PathString;
  122. VAR
  123.   S:           PathString;
  124.   I:           INTEGER;
  125. BEGIN
  126.   S := PathName;
  127.   I := Length(S);
  128.   IF POS('\',S) > 0 THEN            {If there's a pathname, find the end}
  129.     BEGIN
  130.       WHILE S[I] <> '\' DO
  131.         I := PRED(I);
  132.     END
  133.   ELSE
  134.     I := POS(':',S);
  135.   IF I = 0 THEN
  136.     S := ''
  137.   ELSE
  138.     DELETE (S,I+1,(Length(S)-I));     {Delete wildcard stuff if any}
  139.   FullFileName := S + FileName;
  140. END;
  141.  
  142. PROCEDURE WalkTree (BeginningPath:PathString);
  143. VAR
  144.   FileArea:    FileInfo;
  145.   FileFound:   BOOLEAN;
  146.   NewPath:     PathString;
  147.  
  148. PROCEDURE ProcessDirEntry;
  149. BEGIN
  150.   NewPath := FullFileName(BeginningPath,AsciiZ2S(FileArea.FileName));
  151.   IF (((FileArea.Attr AND $10) <> 0)
  152.   AND (FileArea.FileName[0] <> '.')) THEN
  153.     BEGIN
  154.       WRITELN ('*** SUBDIRECTORY *** ',NewPath);
  155.       WalkTree (NewPath+'\*.*');
  156.     END
  157.   ELSE
  158.     WRITELN(NewPath);
  159. END;
  160.  
  161. BEGIN  {WalkTree}
  162.   FileFound := FindFirst (BeginningPath,$16,FileArea);
  163.   IF FileFound THEN
  164.     ProcessDirEntry;
  165.   WHILE FileFound DO
  166.     BEGIN
  167.       FileFound := FindNext(FileArea);
  168.       IF FileFound THEN
  169.         ProcessDirEntry;
  170.     END;
  171. END;  {WalkTree}
  172.  
  173. BEGIN {Main}
  174.   IF (DosVersion < 200) THEN
  175.     BEGIN
  176.       WRITELN('Valid only for DOS Version 2.0 and up');
  177.       HALT;
  178.     END;
  179.   CurrentPath := 'c:\*.*';                            {----- Where to begin }
  180.   WalkTree (CurrentPath);
  181.  
  182.   END.
  183.