home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / sampler / 03 / diverse / directre.pas next >
Encoding:
Pascal/Delphi Source File  |  1988-09-09  |  4.6 KB  |  188 lines
  1. {DIRECTRE.PAS}
  2. {
  3. Description:  Directory "Tree" program that displays the contents of a
  4.               specified directory and all its subdirectories. The user
  5.               enters both the starting search directory and a file name
  6.               mask; standard DOS wildcards are supported. This program
  7.               was written as a demonstration of the combined power of
  8.               pointer variables and recursive programming techniques.
  9.  
  10. Author:       Don Taylor
  11. Date:         3/10/88
  12. Last revised: 04/01/1988  09:42
  13. Application:  PC-DOS/MS-DOS version 2 or greater; Turbo Pascal 4.0
  14.  
  15. }
  16.  
  17.  
  18. PROGRAM DirecTREE;
  19.  
  20. USES
  21.  Crt, Dos;
  22.  
  23. VAR
  24.  FileMask  : STRING;
  25.  PathName  : STRING;
  26.  FileAttr  : BYTE;
  27.  DirLevel  : WORD;
  28.  
  29. {--------------------}
  30.  
  31. PROCEDURE GetParameters;
  32.  
  33. VAR
  34.  FMask : STRING;
  35.  PName : STRING;
  36.  
  37. BEGIN
  38.  ClrScr;
  39.  WRITELN('DirecTREE Directory Scanning Demo -------------------');
  40.  GOTOXY(1,5); WRITE('  File specification: ', FileMask);
  41.  GOTOXY(23,5); READLN(FMask);
  42.  IF FMask <> '' THEN FileMask := FMask;
  43.  GOTOXY(1,7); WRITE('  Starting directory: ', PathName);
  44.  GOTOXY(23,7); READLN(PName);
  45.  IF PName <> '' THEN PathName := PName
  46. END;  { GetParameters }
  47.  
  48. {--------------------}
  49.  
  50. PROCEDURE ProcessFile(ThePath      : STRING;      { The path to search     }
  51.                       TheFileInfo  : SearchRec;   { The info on the file   }
  52.                       ThisAttrib   : BYTE);       { Attribute of the file  }
  53.  
  54. VAR
  55.  ch : CHAR;
  56.  s  : STRING;
  57.  ss : STRING;
  58.  
  59. BEGIN
  60.  { Specific file processing routines start here...}
  61.  
  62.  s := '  ' + TheFileInfo.Name + '             ';
  63.  s := COPY(s,1,18);
  64.  STR(TheFileInfo.Size : 7,ss);
  65.  WRITELN(s + ss);
  66.  
  67.  IF KeyPressed
  68.   THEN BEGIN { pause }
  69.         ch := ReadKey;
  70.         ch := ReadKey
  71.        END;
  72.  
  73.  { ..and end here. }
  74. END;  { ProcessFile }
  75.  
  76. {--------------------}
  77.  
  78. PROCEDURE ProcessDirectory(ThePath      : STRING;  { The path to search     }
  79.                            TheFileMask  : STRING;  { The mask to match      }
  80.                            TheAttribute : BYTE);   { The attribute to match }
  81.  
  82. TYPE
  83.  DirRecPtr = ^DirRec;
  84.  
  85.  DirRec = RECORD
  86.            ThisFile : SearchRec;
  87.            NextFile : DirRecPtr
  88.           END;
  89.  
  90. CONST
  91.  AnyFileSpec = '*.*';
  92.  
  93. VAR
  94.  EntriesFound : INTEGER;
  95.  TheFileInfo  : SearchRec;
  96.  TheFileSpec  : STRING;
  97.  DPtr         : DirRecPtr;
  98.  ThisDPtr     : DirRecPtr;
  99.  DirBase      : DirRecPtr;
  100.  DirPath      : STRING;
  101.  MemMark      : ^INTEGER;
  102.  
  103. BEGIN
  104. { First, process all files... }
  105.  
  106.  Mark(MemMark);
  107.  EntriesFound := 0;
  108.  DirLevel     := SUCC(DirLevel);
  109.  IF ThePath[LENGTH(ThePath)] <> '\'
  110.   THEN ThePath := ThePath + '\';
  111.  
  112.  TheFileSpec := ThePath + TheFileMask;
  113.  
  114.  FindFirst(TheFileSpec, TheAttribute - Directory, TheFileInfo);
  115.  WHILE DosError = 0 DO
  116.   BEGIN
  117.    EntriesFound := SUCC(EntriesFound);
  118.    ProcessFile(ThePath, TheFileInfo, TheFileInfo.Attr);
  119.    FindNext(TheFileInfo)
  120.   END; { WHILE }
  121.  
  122.  
  123. { Now make a list of all subdirectories... }
  124.  
  125.  EntriesFound := 0;
  126.  DirBase := NIL;
  127.  ThisDPtr := NIL;
  128.  DPtr := NIL;
  129.  
  130.  FindFirst(ThePath + AnyFileSpec, Directory, TheFileInfo);
  131.  WHILE DosError = 0 DO
  132.   BEGIN
  133.    IF   (TheFileInfo.Attr = Directory)
  134.     AND (TheFileInfo.Name <> '.') AND (TheFileInfo.Name <> '..')
  135.     THEN BEGIN { add directory to list }
  136.           EntriesFound := SUCC(EntriesFound);
  137.           NEW(DPtr);
  138.           DPtr^.ThisFile := TheFileInfo;
  139.           DPtr^.NextFile := NIL;
  140.           IF EntriesFound = 1
  141.            THEN DirBase := DPtr
  142.            ELSE ThisDPtr^.NextFile := DPtr;
  143.           ThisDPtr := DPtr
  144.          END;
  145.    FindNext(TheFileInfo)
  146.   END; { WHILE }
  147.  
  148.  
  149. { ..and then process all subdirectories }
  150.  
  151.   DPtr := DirBase;
  152.   WHILE DPtr <> NIL DO
  153.    BEGIN
  154.     TheFileInfo := DPtr^.ThisFile;
  155.     DirPath := ThePath + TheFileInfo.Name + '\';
  156.  
  157.   { Specific directory processing routines start here...}
  158.     WRITELN; WRITELN;
  159.     WRITE('DIRECTORY -- PATH: ');
  160.     WRITE(DirPath,' ------------ Level ', DirLevel);
  161.     WRITELN;
  162.   { ..and end here. }
  163.  
  164.     ProcessDirectory(DirPath, TheFileMask, TheAttribute);
  165.     DPtr := DPtr^.NextFile
  166.    END; { WHILE }
  167.   DirLevel := PRED(DirLevel);
  168.   Release(MemMark)
  169. END;  { ProcessDirectory }
  170.  
  171. {====================}
  172.  
  173. BEGIN { DirecTREE }
  174.  ClrScr;
  175.  DirLevel := 0;
  176.  FileAttr := AnyFile;
  177.  FileMask := '*.*';
  178.  PathName := '\';
  179.  GetParameters;
  180.  ClrScr; WRITELN('Directory Listing -------------------------');
  181.  WRITELN;
  182.  WRITELN('Directory mask: ', FileMask);
  183.  WRITELN('Starting at:    ', PathName);
  184.  ProcessDirectory(PathName, FileMask, FileAttr);
  185. END.  { DirecTREE }
  186.  
  187. 
  188.