home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / MURUTIL4.ZIP / FULLDIR.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-10-04  |  3.8 KB  |  165 lines
  1. PROGRAM FULLDIR;
  2.  
  3. {$N-  Don't use the numeric coprocessor. }
  4.  
  5. {  Turbo Pascal V4.0 program to generate a a sorted list of all files in
  6.    the named or default directory and all subdirectories.
  7.  
  8.    Examples:
  9.  
  10.       FULLDIR                 Full directory, starting at the current
  11.                               directory.
  12.  
  13.       FULLDIR  C:\            Full directory, starting at the root of
  14.                               drive C:.
  15.  
  16.    The output of this program can be redirected.  For example:
  17.  
  18.       FULLDIR B:\ > DIR.LIS
  19.  
  20.    Program by Harry M. Murphy,  3 October 1988.  }
  21.  
  22. USES
  23.   DOS;
  24.  
  25. CONST
  26.      MAXNUM = 800;
  27.  
  28. TYPE
  29.      FILEREC = RECORD
  30.                  NAME : STRING[12];
  31.                  PATH : STRING[60]
  32.                END { RECORD };
  33.      FILELST = ARRAY[1..MAXNUM] OF FILEREC;
  34.  
  35. VAR
  36.     DIR   : STRING;
  37.     HOME  : STRING;
  38.     FLIST : FILELST;
  39.     FNUM  : INTEGER;
  40.     N     : INTEGER;
  41.  
  42. { -------------------------------- }
  43.  
  44. PROCEDURE SCANDIRECT;
  45.  
  46. {  This procedure recursively scans each directory and updates the
  47.    file list.  }
  48.  
  49. CONST
  50.     DIRF = $10;
  51.     LOOK = $16;
  52.  
  53. VAR
  54.     DIR  : STRING;
  55.     SRCH : SEARCHREC;
  56.  
  57. BEGIN
  58.   GETDIR(0,DIR);
  59.   FINDFIRST('*.*',LOOK,SRCH);
  60.   WHILE DOSERROR = 0 DO
  61.     BEGIN
  62.       IF (SRCH.ATTR AND DIRF) <> 0
  63.         THEN
  64.           BEGIN
  65.             IF SRCH.NAME[1] <> '.'
  66.               THEN
  67.                 BEGIN
  68.                   CHDIR(SRCH.NAME);
  69.                   SCANDIRECT;
  70.                   CHDIR('..')
  71.                 END
  72.           END
  73.         ELSE
  74.           BEGIN
  75.             IF FNUM < MAXNUM
  76.               THEN
  77.                 BEGIN
  78.                   FNUM := SUCC(FNUM);
  79.                   FLIST[FNUM].NAME := SRCH.NAME;
  80.                   FLIST[FNUM].PATH := DIR
  81.                 END
  82.               ELSE
  83.                 BEGIN
  84.                   WRITELN('File table overflow!');
  85.                   HALT
  86.                 END
  87.           END;
  88.       FINDNEXT(SRCH)
  89.     END
  90. END { Procedure SCANDIRECT };
  91.  
  92. { -------------------------------- }
  93.  
  94. PROCEDURE SORTFILE(VAR FLIST: FILELST; FNUM: INTEGER);
  95.  
  96. {  This routine sorts the file name array, FLIST, in ascending order,
  97.    using a modified Shell sort algorithm.   FNUM is the length of the
  98.    array.  }
  99.  
  100. VAR
  101.     I,IM,J,M : INTEGER;
  102.     SWAP     : BOOLEAN;
  103.     TEMP     : FILEREC;
  104.  
  105. BEGIN  { Procedure SORTFILE }
  106.   IF FNUM > 1
  107.     THEN
  108.       BEGIN
  109.         M := 1;
  110.         WHILE M < FNUM DO M := 2*M;
  111.         M := PRED(M);
  112.         WHILE M > 1 DO
  113.           BEGIN
  114.             M := M DIV 2;
  115.             FOR J:=1 TO FNUM-M DO
  116.               BEGIN
  117.                 I := J;
  118.                 REPEAT
  119.                   IM := I+M;
  120.                   SWAP := FLIST[I].NAME > FLIST[IM].NAME;
  121.                   IF SWAP
  122.                     THEN
  123.                       BEGIN
  124.                         TEMP := FLIST[I];
  125.                         FLIST[I] := FLIST[IM];
  126.                         FLIST[IM] := TEMP;
  127.                         I := I-M
  128.                       END
  129.                 UNTIL (I < 1 ) OR (NOT SWAP)
  130.               END
  131.           END
  132.       END
  133. END { Procedure SORTFILE };
  134.  
  135. { -------------------------------- }
  136.  
  137. BEGIN
  138.   GETDIR(0,HOME);
  139.   DIR := HOME;
  140.   IF PARAMCOUNT > 0
  141.     THEN
  142.       BEGIN
  143.         CHDIR(PARAMSTR(1));
  144.         IF IORESULT = 0
  145.           THEN
  146.             GETDIR(0,DIR)
  147.           ELSE
  148.             BEGIN
  149.               WRITELN('Can''t find directory ',PARAMSTR(1));
  150.               HALT
  151.             END
  152.       END;
  153.   FNUM := 0;
  154.   SCANDIRECT;
  155.   IF DIR <> HOME THEN CHDIR(HOME);
  156.   SORTFILE(FLIST,FNUM);
  157.   ASSIGN(OUTPUT,'');
  158.   REWRITE(OUTPUT);
  159.   WRITELN('Full directory of files in and below ',DIR,':');
  160.   WRITELN;
  161.   FOR N := 1 TO FNUM DO WRITELN(FLIST[N].NAME:12,'  ',FLIST[N].PATH);
  162.   WRITELN;
  163.   WRITELN(FNUM,' files.')
  164. END.
  165.