home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / NDR.ZIP / NDR.PAS
Encoding:
Pascal/Delphi Source File  |  1985-12-28  |  10.3 KB  |  253 lines
  1. PROGRAM nDR;
  2. (* Gets and writes a directory of a selected disk: gives file sizes
  3. in k, sorts alphabetically, correctly treats large files >1 extent. If
  4. procedure SIZ is included, it calculates and displays disk space data.
  5. Mike Yarus, 2231 16th Street, Boulder, CO 80302, Compuserve 73145,513. *)
  6.  
  7. (* This adaptation by--Bob Durling, 12-8-85-- adds auccessive directories
  8. to an index file that includes a user-supplied disk name.  Hereby placed
  9. in public  all commercial use restricted.                                *)
  10.  
  11. (* As now set up, the program must be run form disk A: (or ramdisk),
  12. since it provides for resetting disk B: when the disk to be catalogued
  13. is inserted.  This could be changed, of course. *)
  14.  
  15. TYPE
  16.     TWELVESTR = STRING[12];
  17.     DP = ^DIRENTRY;
  18.     DIRENTRY = RECORD
  19.                  FNAME: TWELVESTR; (* file name *)
  20.                  FSIZE: BYTE;      (* file size *)
  21.                  LEFTP, RIGHTP: DP (* l & r pointers *)
  22.                END;
  23. VAR
  24.    answer : char;
  25.    flout : text;
  26.    date, dskname, flname : twelvestr;
  27.    MYFCB: ARRAY [0..35] OF BYTE;  (* a special File Control Block *)
  28.    MYDMA: ARRAY [0..127] OF BYTE; (* a special directory buffer *)
  29.    NDEX,
  30.    BDOSFN,        (* number of the CP/M BDOS function required *)
  31.    DIRPAGENDEX,   (* which of the 4 dir entries in MYDMA is current? *)
  32.    LINECONTROL,   (* # directory entries, controls print position *)
  33.    ENTRIES: BYTE; (* number of directory entries, including >1 extents *)
  34.    FILES,         (* nr files *)
  35.    OCCUPADO: INTEGER;             (* space now taken by files *)
  36.    DUMMY,
  37.    DRV: CHAR;   (* A, B,..  drives *)
  38.    ENTRYP, ROOP: DP;              (* the root and new entry pointer *)
  39.  
  40. FUNCTION DRIVENR: BYTE;
  41. { Asks for drive letter, converts to CP/M's number, updates global DRV as
  42. side effect; take that, Niklaus. }
  43. BEGIN
  44.   WRITE('Directory of disk on which drive ? --> L<cr> ');
  45.   READLN (DRV);
  46.   DRV := UPCASE (DRV);
  47.   WRITELN;                    {line above directory}
  48.   DRIVENR := ORD (DRV) - $40  {1 = drive A:, 2 = B:, 4 = D:}
  49. END;  { drivenr }
  50.  
  51. PROCEDURE SIZ (ENTRIES: BYTE; FILES, OCCUPADO: INTEGER);
  52. (*  Calculates storage params by consulting the current info in the BIOS.
  53. DR can be shortened by just removing this procedure and its call in
  54. the main program.  *)
  55. TYPE
  56.     IP = ^INTEGER;
  57. VAR
  58.     DSMPTR, DRMPTR: IP;
  59.     DPB, BLOCK, DSM, DRM, DIRSIZE, REMAINS, STORAGE: INTEGER;
  60.     BLM, NEWD, CURRENTDSK, DIRBLOCKS, AL0, AL0MASK: BYTE;
  61.  
  62. BEGIN
  63.   NEWD := ORD (DRV) - $41;         (* CP/M disk #, 00 = A:, etc *)
  64.   CURRENTDSK := BDOS(25);          (* get the present disk # *)
  65.   BDOS (14, NEWD);                 (* select the new disk *)
  66.   DPB := BDOSHL(31);               (* get DPB (disk parameter block) address *)
  67.   DRMPTR := PTR(DPB+7);            (* point to DRM, max directory entries-1 *)
  68.   DRM := DRMPTR^;                  (* get DRM *)
  69.   DSMPTR := PTR(DPB+5);            (* point to DSM, max # data blocks-1 *)
  70.   DSM := DSMPTR^;                  (* get DSM *)
  71.   BLM := MEM [DPB+3];              (* get BLM, related to data block size *)
  72.   BLOCK := (BLM+1) DIV 8;          (* calc data block size in kbytes *)
  73.   DIRBLOCKS := 0;                  (* initiate # blocks for directory *)
  74.   AL0 := MEM [DPB+9];              (* get AL0, directory storage allocation *)
  75.   AL0MASK := $80;                  (* 10000000 binary, for bit masking *)
  76.   WHILE ((AL0 AND AL0MASK) <> 0) AND (AL0MASK >= 1) DO
  77.   BEGIN                            (* get the # of directory blocks *)
  78.     DIRBLOCKS := DIRBLOCKS + 1;
  79.     AL0MASK := AL0MASK DIV 2
  80.   END;
  81.   DIRSIZE := DIRBLOCKS * BLOCK;    (* size of the tirectory, in kbytes *)
  82.   STORAGE := BLOCK * (DSM+1);      (* total storage (kbytes) = block X #blocks *)
  83.   REMAINS := STORAGE - DIRSIZE - OCCUPADO;
  84.   WRITELN; WRITELN; writeln(flout1);
  85.   WRITELN ('    ',DRV,': ',REMAINS,'k remain/',STORAGE,'k total -- ',
  86.           FILES,' files = ',OCCUPADO,'k - ',
  87.           ENTRIES,'/',DRM+1,'  entries');
  88.   WRITELN ('    ',MEM [DPB+13],' system track(s) -- ',  (* delete this statement *)
  89.           MEM [DPB],' records/track -- ',               (* if disk structure data *)
  90.           DIRBLOCKS,' directory blocks -- ',            (* is not wanted *)
  91.           BLOCK,'k blocks');
  92.   WRITELN;
  93.   BDOS (14, CURRENTDSK)            (* reselect original disk *)
  94. END;
  95.  
  96. PROCEDURE FILECONTROLBLOCK (DR: BYTE);
  97. (*  File control block set for reading all files,  filename = ????????.???
  98. Note that when only the first extent of a big file is needed (eg, for a
  99. list of file names only) one sets 13th byte (ndex = 12) of the fcb to zero.  *)
  100. BEGIN
  101.   MYFCB [0] := DR;        (* which drive? *)
  102.   FOR NDEX := 1 TO 12 DO  (* set for ambiguous file name AND extent *)
  103.     MYFCB [NDEX] := ORD ('?');
  104.   FOR NDEX := 13 TO 35 DO (* some of the other bytes must be = 0 *)
  105.     MYFCB [NDEX] := 0     (* set them all, what the heck? *)
  106. END; (*  filecontrolblock  *)
  107.  
  108. PROCEDURE WRITIT (AFILENAME: TWELVESTR; KBYTES: BYTE);
  109. (*  Output of dir info in lines; set for 3 entries/line.  *)
  110. BEGIN
  111.   LINECONTROL := LINECONTROL + 1;  (* increment entries *)
  112.   IF LINECONTROL MOD 3 = 1 THEN
  113.    begin
  114.     WRITE('    ',AFILENAME,' ',KBYTES:3,'k ');
  115.     writeln(flout, afilename,' ',kbytes:3, 'k   ', dskname);
  116.     end
  117.    else begin
  118.     WRITE(':  ',AFILENAME,' ',KBYTES:3,'k ');
  119.     writeln(flout,afilename,' ',kbytes:3,'k   ', dskname);
  120.    end;
  121.   IF LINECONTROL MOD 3 = 0 THEN WRITELN;
  122. END;  (*  writit  *)
  123.  
  124. {$A-} (* **** recursive reference needed from here on **** *)
  125.  
  126. PROCEDURE BUILDTREE (VAR ROP, ENTRYP: DP);
  127. (*  Builds an ordered tree of directory entries.  Note that replace
  128. function in code takes care of duplicate entries in dictionary due
  129. to large files present in >1 extent.  *)
  130. BEGIN
  131.   IF ROP = NIL THEN                     (* end of limb, place current entry *)
  132.     ROP := ENTRYP
  133.   ELSE
  134.     IF ROP^.FNAME = ENTRYP^.FNAME THEN  (* replace entry, if >1 extent *)
  135.     BEGIN
  136.       ROP^.FSIZE := ENTRYP^.FSIZE;
  137.       DISPOSE (ENTRYP)
  138.     END
  139.     ELSE
  140.       IF ROP^.FNAME > ENTRYP^.FNAME THEN (* left for small *)
  141.         BUILDTREE (ROP^.LEFTP, ENTRYP)
  142.       ELSE
  143.         BUILDTREE (ROP^.RIGHTP, ENTRYP)  (* right for large *)
  144. END; (*  buildtree  *)
  145.  
  146. PROCEDURE WRITETREE (VAR ROP: DP; VAR FILES, OCCUPADO: INTEGER);
  147. (*  Recursively writes the directory inorder (alphabetically) from the rop.
  148. Updates global OCCUPADO and FILES. Recalculates file sizes to make them
  149. end on allocation block borders, as they must.  *)
  150. BEGIN
  151.   IF ROP <> NIL THEN
  152.   BEGIN
  153.     WRITETREE (ROP^.LEFTP, FILES, OCCUPADO);
  154.     ROP^.FSIZE := ROP^.FSIZE +
  155.       ROP^.FSIZE MOD ((MEM [BDOSHL(31)+3] + 1) DIV 8); (* file size modulo *)
  156.     WRITIT (ROP^.FNAME, ROP^.FSIZE);                   (* block size must be *)
  157.     OCCUPADO := OCCUPADO + ROP^.FSIZE;                 (* equal zero *)
  158.     FILES := FILES + 1;
  159.     WRITETREE (ROP^.RIGHTP, FILES, OCCUPADO)
  160.   END
  161. END; (*  writetree  *)
  162.  
  163. PROCEDURE DISPOTREE (VAR ROP: DP);
  164. (*  Disposes the storage devoted to the tree postorder.  Required
  165. mainly for repetitive execution of the program within a larger
  166. program, since directory tree is fairly small.  *)
  167. BEGIN
  168.   IF ROP <> NIL THEN
  169.   BEGIN
  170.     DISPOTREE (ROP^.LEFTP);
  171.     DISPOTREE (ROP^.RIGHTP);
  172.     DISPOSE (ROP)
  173.   END
  174. END;  (*  dispotree  *)
  175.  
  176. PROCEDURE GETENTRY (BDOSFN: BYTE; VAR ENTRIES: BYTE; VAR ROP: DP);
  177. (*  Finds and writes a single directory entry from the disk directory
  178. to the directory tree; makes a tree via BUILDTREE.  *)
  179. VAR
  180.    NDEX: BYTE;
  181.    ENTRYSIZE: REAL; (* in bytes, real because can be > maxint *)
  182. BEGIN
  183.   NEW (ENTRYP);
  184.   DIRPAGENDEX := BDOS (BDOSFN, ADDR (MYFCB));         (* get directory in MYDMA *)
  185.   IF (MYDMA [DIRPAGENDEX * 32] = 0) AND (DIRPAGENDEX <> $FF) THEN
  186.   BEGIN                             (* entry is not erased AND entry exists *)
  187.     ENTRYP^.FNAME [0] := CHR (12);  (* CP/M pads all filenames to full size *)
  188.     FOR NDEX := 1 TO 8 DO           (* get file name *)
  189.       ENTRYP^.FNAME [NDEX] := CHR (MYDMA [DIRPAGENDEX * 32 + NDEX]);
  190.     ENTRYP^.FNAME [9] := '.';
  191.     FOR NDEX := 9 TO 11 DO          (* get file extension *)
  192.       ENTRYP^.FNAME [NDEX + 1] := CHR (MYDMA [DIRPAGENDEX * 32 + NDEX]);
  193.     ENTRYSIZE := 1.0 * ((MYDMA [DIRPAGENDEX * 32 + 12] * 128) + (* 13th byte # extents *)
  194.                 MYDMA [DIRPAGENDEX * 32 + 15]) * 128; (* 16th byte is # records *)
  195.     ENTRYP^.FSIZE := ROUND ((ENTRYSIZE/1024) + 0.499);(* round up to next kbyte *)
  196.       ENTRYP^.LEFTP := NIL;
  197.       ENTRYP^.RIGHTP := NIL;
  198.       ENTRIES := ENTRIES + 1;
  199.     BUILDTREE (ROOP, ENTRYP)                          (* put the entry in tree *)
  200.   END (* if mydma.. *)
  201. END; (*  getentry  *)
  202.  
  203. BEGIN (* main  *)
  204.   writeln('Program must be run from disk A: or ramdisk.');
  205.   repeat
  206.    write('Enter name of index file -- ');
  207.    readln(flname);
  208.    assign(flout2, flname);
  209.    {$I-} reset(flout2); {$I+}
  210.    if ioresult = 0 then
  211.      begin
  212.        write('File exists -- overwrite ? ');
  213.        readln(answer);
  214.        if upcase(answer) = 'Y' then rewrite(flout);
  215.      end;
  216.    until (upcase(answer) = 'Y') or (ioresult <> 0);
  217.   write('Enter date -- ');
  218.   readln(date);
  219.   write('Enter name of disk -- ');
  220.   readln(dskname);
  221.   writeln(flout, '   ', date);
  222.   writeln(flout);
  223.  repeat
  224.   LINECONTROL := 0;    (* initiate for output print control *)
  225.   ROOP := NIL;         (* initiate directory tree *)
  226.   ENTRIES := 0;        (* nr entries in disk directory *)
  227.   FILES := 0;          (* nr files *)
  228.   OCCUPADO := 0;       (* disk storage used *)
  229.   BDOS (26, ADDR (MYDMA));     (* define MYDMA to buffer directory *)
  230.   FILECONTROLBLOCK (DRIVENR);  (* get disk name, set ambiguous filenames *)
  231.   BDOSFN := 17;        (* search for first file *)
  232.   REPEAT
  233.     GETENTRY (BDOSFN, ENTRIES, ROOP);   (* get'em and tree'em *)
  234.     BDOSFN := 18       (* switch to search for next after first file *)
  235.   UNTIL DIRPAGENDEX = $FF;     (* no files left *)
  236.   WRITETREE (ROOP, FILES, OCCUPADO);    (* sorted directory OUT! *)
  237.   SIZ (ENTRIES, FILES, OCCUPADO);       (* get disk storage statistics *)
  238.   DISPOTREE (ROOP);     (* release storage *)
  239. {$A+}
  240.   write('Continue ? ');
  241.   read(kbd, answer);
  242.   if upcase(answer) <> 'N' then
  243.     begin
  244.       write('Change disk in drive B: , then type <CR> --');
  245.       read(answer);   writeln;
  246.       bdos($25,2);
  247.       write('Enter name of disk -- ');
  248.       readln(dskname);
  249.     end;
  250.  until upcase(answer) = 'N';
  251.  close(flout);
  252. END.  (*  dr  *)
  253.