home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TP4TUT2B.ZIP / OT3.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-01-15  |  25.2 KB  |  676 lines
  1. program Oak_Tree;       (* This version is for TURBO Pascal 3.0 *)
  2.  
  3. (*                 XXX     X    X   X  XXXXX  XXXX   XXXXX  XXXXX
  4.   Jan 15, 1988    X   X   X X   X  X     X    X   X  X      X
  5.                   X   X  X   X  X X      X    X   X  X      X
  6.                   X   X  X   X  XX       X    XXXX   XXX    XXX
  7.                   X   X  XXXXX  X X      X    X X    X      X
  8.                   X   X  X   X  X  X     X    X  X   X      X
  9.                    XXX   X   X  X   X    X    X   X  XXXXX  XXXXX
  10. *)
  11.  
  12. const  Page_Size = 66;
  13.        Max_Lines = 55;
  14.  
  15. type   Command_String = string[127];
  16.  
  17.        Output_Type = (Directories,Files);
  18.  
  19.        Regpack = record
  20.                  AX,BX,CX,DX,BP,SI,DI,DS,ES,FLAGS:integer;
  21.                  end;
  22.  
  23.        Dir_Rec     = ^Dirtree;    (* Dynamic storage for dir names *)
  24.        Dirtree     = record
  25.          Next      : Dir_Rec;
  26.          Dir_Name  : string[15];
  27.       end;
  28.  
  29.        Filerec     = ^Filetree;         (* Dynamic storage for the *)
  30.        Filetree    = record             (* filename sorting tree   *)
  31.          Left      : Filerec;
  32.          Right     : Filerec;
  33.          case boolean of
  34.          TRUE :  (Attribute : byte;
  35.                   File_Time : array[1..2] of byte;
  36.                   File_Date : array[1..2] of byte;
  37.                   File_Size : array[1..4] of byte;
  38.                   File_Name : array[1..13] of char);
  39.          FALSE : (File_Rec  : array[1..23] of char);
  40.        end;
  41.  
  42. var   File_Point     : Filerec;        (* Pointer to a file record *)
  43.       Page_Number    : integer;
  44.       Line_Number    : integer;
  45.       Directory_Count : integer;
  46.       Recpack        : Regpack;
  47.       Dta            : array[1..43] of char;  (* Disk xfer address *)
  48.       File_Request   : string[25];
  49.       Root_Mask      : Command_String;(* Used for vol-label search *)
  50.       Starting_Path  : Command_String;
  51.       Cluster_Size   : integer;
  52.       Sectors_Per_Cluster : integer;
  53.       Free_Clusters  : integer;
  54.       Bytes_Per_Sector : integer;
  55.       Total_Clusters : integer;
  56.       Do_We_Print    : boolean;           (* Print or not          *)
  57.       Do_All_Stats   : boolean;           (* List all disk stats?  *)
  58.       No_Files_Out   : boolean;           (* List no files         *)
  59.       Which_List     : Output_Type;
  60.       Real_Size      : real;
  61.       R1,R2,R3       : real;
  62.       Total_Cbytes   : real;
  63.       Total_Bytes    : real;
  64.       All_Files      : integer;
  65.       Req_Files      : integer;
  66.  
  67. (* **************************************************** Initialize *)
  68. (* This procedure is used to initialize some variables and strings *)
  69. (* prior to starting the disk search.                              *)
  70. procedure Initialize;
  71. begin
  72.    Page_Number := 1;
  73.    Line_Number := 1;
  74.    Directory_Count := 0;
  75.    Total_Cbytes := 0;
  76.    Total_Bytes := 0;
  77.    All_Files := 0;
  78.    Req_Files := 0;
  79.    Root_Mask := 'C:\*.*';
  80.    Root_Mask[Length(Root_Mask) + 1] := Chr(0);
  81.                            (* Get the current default drive letter *)
  82.    Recpack.AX := $1900;
  83.    Intr($21,Recpack);
  84.    Root_Mask[1] := Chr(Recpack.AX and $F + Ord('A'));
  85. end;
  86.  
  87. (* ****************************** Read And Parse Command Arguments *)
  88. (* This procedure reads in the command line arguments, parses them,*)
  89. (* and sets up the switches and defaults for the disk searches.    *)
  90. procedure Read_And_Parse_Command_Arguments;
  91. var    Parameters_Input   : Command_String absolute Cseg:$80;
  92.        Parameters         : Command_String;
  93.        Index              : byte;
  94.        Temp_Store         : char;
  95. begin
  96.    Do_We_Print := FALSE;
  97.    Do_All_Stats := FALSE;
  98.    No_Files_Out := FALSE;
  99.  
  100.            (* First, preserve the input area to allow F3 to repeat *)
  101.    for Index := 0 to Length(Parameters_Input) do
  102.       Parameters[Index] := Parameters_Input[Index];
  103.    for Index := 1 to Length(Parameters) do begin
  104.                                    (* Find designated drive letter *)
  105.       if ((Parameters[Index] = ':') and (Index > 1)) then begin
  106.          Root_Mask[1] := Parameters[Index-1];
  107.          Parameters[Index-1] := ' ';
  108.          Parameters[Index] := ' ';
  109.       end;
  110.                                      (* Find command line switches *)
  111.       if (Parameters[Index] = '/') and (Index < Length(Parameters))
  112.       then begin
  113.          Temp_Store := Upcase(Parameters[Index + 1]);
  114.          if Temp_Store = 'P' then Do_We_Print := TRUE;
  115.          if Temp_Store = 'N' then No_Files_Out := TRUE;
  116.          if Temp_Store = 'S' then Do_All_Stats := TRUE;
  117.          Parameters[Index] := ' ';
  118.          Parameters[Index+1] := ' ';
  119.       end;
  120.    end;
  121.                      (* get the current path on the selected drive *)
  122.    Getdir(Ord(Root_Mask[1])-Ord('A') + 1,Starting_Path);
  123.    if Length(Starting_Path) > 3 then
  124.       Starting_Path := Starting_Path + '\';
  125.  
  126.                  (* Finally, find the file name mask for searching *)
  127.    repeat                                 (* Remove leading blanks *)
  128.       if Parameters[1] = ' ' then
  129.          Delete(Parameters,1,1);
  130.    until (Parameters[1] <> ' ') or (Length(Parameters) = 0);
  131.  
  132.    Index := 0;       (* Remove everything trailing the first entry *)
  133.    repeat
  134.       Index := Index + 1;
  135.    until (Parameters[Index] = ' ') or (Index=Length(Parameters) + 1);
  136.    Delete(Parameters,Index,127);
  137.    if Parameters = '' then
  138.       File_Request := '*.*'
  139.    else
  140.       File_Request := Parameters;
  141. end;
  142.  
  143. (* ********************************************* count print lines *)
  144. procedure Count_Print_Lines(Line_Count : byte);
  145. var Count : byte;
  146. begin
  147.    if Do_We_Print then begin
  148.       if Line_Count > 250 then (* This signals the end of the tree *)
  149.       begin                    (* Space up to a new page           *)
  150.          for Count := Line_Number to (Page_Size - 3) do
  151.             Writeln(Lst);
  152.          Line_Number := 1;
  153.          Line_Count := 0;
  154.       end;
  155.       Line_Number := Line_Number + Line_Count;
  156.       if Line_Number > Max_Lines then begin
  157.          Page_Number := Page_Number +1;
  158.          for Count := Line_Number to (Page_Size - 2) do
  159.             Writeln(Lst);
  160.          Writeln(Lst,'                           Page',
  161.                                                   Page_Number:4);
  162.          Writeln(Lst);
  163.          Line_Number := 1;
  164.       end;
  165.    end;
  166. end;
  167.  
  168. (* ************************************************** Print Header *)
  169. (* In this section of code, the volume label is found and displayed*)
  170. (* and the present time and date are determined and displayed.     *)
  171. procedure Print_Header;
  172. var Month,Day,Hour,Minute : string[2];
  173.     Year                  : string[4];
  174.     Error                 : integer;
  175.     Attribute             : byte;
  176.     Temp                  : byte;
  177.     Done                  : boolean;
  178.     Index                 : integer;
  179. begin
  180.    if Do_We_Print then begin
  181.       Writeln(Lst);
  182.       Writeln(Lst);
  183.       Writeln(Lst);
  184.       Write(Lst,'          Directory for ');
  185.    end;
  186.    Write('          Directory for ');
  187.    Recpack.AX := $1A00;                          (* Set up the DTA *)
  188.    Recpack.DS := Seg(Dta);
  189.    Recpack.DX := Ofs(Dta);
  190.    Msdos(Recpack);                           (* DTA setup complete *)
  191.    Error := Recpack.AX and $FF;
  192.    if Error > 0 then Writeln('DTA setup error ',Error);
  193.  
  194.    Recpack.AX := $4E00;                       (* Get the volume ID *)
  195.    Recpack.DS := Seg(Root_Mask[1]);
  196.    Recpack.DX := Ofs(Root_Mask[1]);
  197.    Recpack.CX := 8;
  198.    Intr($21,Recpack);
  199.    Error := Recpack.AX and $FF;
  200.    Attribute := $1F and Mem[Seg(Dta):Ofs(Dta) + 21];
  201.  
  202.    if ((Error > 0) or (Attribute <> 8)) then begin
  203.       if Do_We_Print then
  204.          Write(Lst,' <no vol label> ');
  205.       Write(' <no vol label> ');
  206.    end
  207.    else begin                            (* Write out Volume Label *)
  208.       Done := FALSE;
  209.       for Index := 30 to 41 do begin
  210.          Temp := Mem[Seg(Dta):Ofs(Dta) + Index];
  211.          if Temp <> Ord('.') then begin  (* Eliminate '.' in label *)
  212.             if Temp = 0 then Done := TRUE;
  213.             if Done = FALSE then begin
  214.                if Do_we_Print then
  215.                   Write(Lst,Chr(Temp));
  216.                Write(Chr(Temp));
  217.             end;
  218.          end;
  219.       end;
  220.    end;
  221.  
  222.    Write('             ');
  223.    if Do_We_Print then
  224.       Write(Lst,'             ');
  225.    Recpack.AX := $2A00;                    (* Get the present date *)
  226.    Msdos(Recpack);
  227.    Str(Recpack.CX:4,Year);
  228.    Str((Recpack.DX mod 256):2,Day);
  229.    Str((Recpack.DX shr 8):2,Month);
  230.    if Day[1] = ' ' then Day[1] := '0';
  231.    Write(Month,'/',Day,'/',Year);
  232.    if Do_We_Print then
  233.       Write(Lst,Month,'/',Day,'/',Year);
  234.    Recpack.AX := $2C00;                    (* Get the present time *)
  235.    Msdos(Recpack);
  236.    Str((Recpack.CX shr 8):2,Hour);
  237.    Str((Recpack.CX mod 256):2,Minute);
  238.    if Minute[1] = ' ' then Minute[1] := '0';
  239.    Writeln('    ',Hour,':',Minute);
  240.    Writeln;
  241.    if Do_We_Print then begin
  242.       Writeln(Lst,'    ',Hour,':',Minute);
  243.       Writeln(Lst);
  244.       Count_Print_Lines(2);
  245.    end;
  246.                                   (* get all of the disk constants *)
  247.    Recpack.AX := $3600;
  248.    Recpack.DX := (Ord(Root_Mask[1]) - 64) and $F;
  249.    Msdos(Recpack);
  250.    Sectors_Per_Cluster := Recpack.AX;
  251.    Free_Clusters := Recpack.BX;
  252.    Bytes_Per_Sector := Recpack.CX;
  253.    Total_Clusters := Recpack.DX;
  254.  
  255.    Cluster_Size := Bytes_Per_Sector * Sectors_Per_Cluster;
  256.  
  257.    if Do_All_Stats then begin (* Print out disk stats if asked for *)
  258.       Write('             bytes/sector =',Bytes_Per_Sector:6);
  259.       R1 := Total_Clusters;
  260.       R2 := Cluster_Size;
  261.       R1 := R1 * R2;
  262.       Writeln('       total disk space =',R1:12:0);
  263.       Write('            bytes/cluster =',Cluster_Size:6);
  264.       R3 := Free_Clusters;
  265.       R2 := R3 * R2;
  266.       Writeln('        free disk space =',R2:12:0);
  267.       Writeln;
  268.       if Do_We_Print then begin
  269.          Write(Lst,'             bytes/sector =',Bytes_Per_Sector:6);
  270.          Writeln(Lst,'       total disk space =',R1:12:0);
  271.          Write(Lst,'            bytes/cluster =',Cluster_Size:6);
  272.          Writeln(Lst,'        free disk space =',R2:12:0);
  273.          Writeln(Lst);
  274.          Count_Print_Lines(3);
  275.       end;
  276.    end;
  277. end;
  278.  
  279.  
  280. (* *************************************** Position a new filename *)
  281. (* When a new filename is found, this routine is used to locate it *)
  282. (* in the B-TREE that will be used to sort the filenames alphabet- *)
  283. (* ically.                                                         *)
  284. procedure Position_A_New_Filename(Root, New : Filerec);
  285. var    Index   : integer;
  286.        Done    : boolean;
  287. begin
  288.    Index := 1;
  289.    Done := FALSE;
  290.    repeat
  291.       if New^.File_Name[Index] < Root^.File_Name[Index] then begin
  292.          Done := TRUE;
  293.          if Root^.Left = nil then Root^.Left := New
  294.          else
  295.             Position_A_New_Filename(Root^.Left,New);
  296.       end
  297.       else if New^.File_Name[Index] > Root^.File_Name[Index] then
  298.       begin
  299.          Done := TRUE;
  300.          if Root^.Right = nil then
  301.             Root^.Right := New
  302.          else
  303.             Position_A_New_Filename(Root^.Right,New);
  304.       end;
  305.       Index := Index +1;
  306.    until (Index = 13) or Done;
  307. end;
  308.  
  309.  
  310. (* ************************************************** Print a file *)
  311. (* This is used to print the data for one complete file.  It is    *)
  312. (* called with a pointer to the root and an attribute that is to be*)
  313. (* printed.  Either the directories are printed (attribute = $10), *)
  314. (* or the files are printed.                                       *)
  315. procedure Print_A_File(Root : Filerec;
  316.                        Which_List : Output_Type);
  317. var Index,Temp  : byte;
  318.     Temp_String : string[25];
  319.     Day         : string[2];
  320. begin
  321.    Temp := Root^.Attribute;
  322.    if ((Temp =  $10) and (Which_List = Directories)) or
  323.                  ((Temp <> $10) and (Which_List = Files)) then begin
  324.       Write('                ');
  325.       case Temp of
  326.          $27 : Write('<HID>  ');
  327.          $10 : Write('<DIR>  ');
  328.          $20 : Write('       ')
  329.          else  Write('<',Temp:3,'>  ');
  330.       end;   (* of case *)
  331.       if Do_We_Print then begin
  332.          Write(Lst,'                ');
  333.          case Temp of
  334.             $27 : Write(Lst,'<HID>  ');
  335.             $10 : Write(Lst,'<DIR>  ');
  336.             $20 : Write(Lst,'       ')
  337.             else  Write(Lst,'<',Temp:3,'>  ');
  338.          end;   (* of case *)
  339.       end;
  340.       Temp_String := '               ';
  341.       Index := 1;
  342.       repeat
  343.          Temp := Ord(Root^.File_Name[Index]);
  344.          if Temp > 0 then
  345.             Temp_String[Index] := Root^.File_Name[Index];
  346.          Index := Index + 1;
  347.       until (Temp = 0) or (Index = 14);
  348.       Temp_String[0] := Chr(15);
  349.       Write(Temp_String);
  350.       if Do_We_Print then
  351.          Write(Lst,Temp_String);
  352.  
  353.                                         (* Write out the file size *)
  354.       R1 := Root^.File_Size[1];
  355.       R2 := Root^.File_Size[2];
  356.       R3 := Root^.File_Size[3];
  357.       Real_Size := R3*65536.0 + R2 * 256.0 + R1;
  358.       Write(Real_Size:9:0);
  359.       if Do_We_Print then
  360.          Write(Lst,Real_Size:9:0);
  361.                                         (* Write out the file date *)
  362.       Temp := ((Root^.File_Date[1] shr 5) and $7);
  363.       Write('   ',(Temp + ((Root^.File_Date[2] and 1) shl 3)):2,'/');
  364.       if Do_We_Print then
  365.       Write(Lst,'   ',
  366.                     (Temp+((Root^.File_Date[2] and 1) shl 3)):2,'/');
  367.       Str((Root^.File_Date[1] and $1F):2,Day);
  368.       if Day[1] = ' ' then Day[1] := '0';
  369.       Write(Day,'/');
  370.       Write(80 + ((Root^.File_Date[2] shr 1) and $7F),'   ');
  371.       if Do_We_Print then begin
  372.          Write(Lst,day,'/');
  373.          Write(Lst,80 + ((Root^.File_Date[2] shr 1) and $7F),'   ');
  374.       end;
  375.  
  376.                                         (* Write out the file time *)
  377.       Write('  ',((Root^.File_Time[2] shr 3) and $1F):2,':');
  378.       if Do_We_Print then
  379.          Write(Lst,'  ',((Root^.File_Time[2] shr 3) and $1F):2,':');
  380.       Temp := ((Root^.File_Time[2]) and $7) shl 3;
  381.       Str((Temp + ((Root^.File_Time[1] shr 5) and $7)):2,Day);
  382.       if Day[1] = ' ' then Day[1] := '0';
  383.       Writeln(Day);
  384.       if Do_We_Print then begin
  385.          Writeln(Lst,Day);
  386.          Count_Print_Lines(1);
  387.       end;
  388.    end;
  389. end;
  390.  
  391. (* ********************************************* Print a directory *)
  392. (* This is a recursive routine to print out the filenames in alpha-*)
  393. (* betical order.  It uses a B-TREE with "infix" notation.  The    *)
  394. (* actual printing logic was removed to another procedure so that  *)
  395. (* the recursive part of the routine would not be too large and    *)
  396. (* fill up the heap too fast.                                      *)
  397. procedure Print_A_Directory(Root         : Filerec;
  398.                             Which_List   : Output_Type);
  399. begin
  400.    if Root^.Left <> nil then
  401.       Print_A_Directory(Root^.Left,Which_List);
  402.  
  403.    Print_A_File(Root,Which_List);        (* Write out the filename *)
  404.  
  405.    if Root^.Right <> nil then
  406.       Print_A_Directory(Root^.Right,Which_List);
  407. end;
  408.  
  409. (* **************************************************** Erase tree *)
  410. (* After the directory is printed and counted, it must be erased or*)
  411. (* the "heap" may overflow for a large disk with a lot of files.   *)
  412. procedure Erase_Tree(Root : Filerec);
  413. begin
  414.    if Root^.Left  <> nil then Erase_Tree(Root^.Left);
  415.    if Root^.Right <> nil then Erase_Tree(Root^.Right);
  416.    Dispose(Root);
  417. end;
  418.  
  419. (* ************************************************ Do A Directory *)
  420. (* This procedure reads all entries in any directory and sorts the *)
  421. (* filenames alphabetically.  Then it prints out the complete stat-*)
  422. (* istics, and calls itself to do all of the same things for each  *)
  423. (* of its own subdirectories.  Since each subdirectory also calls  *)
  424. (* each of its subdirectories, the recursion continues until there *)
  425. (* are no more subdirectories.                                     *)
  426. procedure Do_A_Directory(Input_Mask : Command_String);
  427. var   Mask          : Command_String;
  428.       Count,Index   : integer;
  429.       Error         : byte;
  430.       Cluster_Count : integer;
  431.       Byte_Count    : real;
  432.       Tree_Root     : Filerec;                (* Root of file tree *)
  433.       Dir_Root      : Dir_Rec;
  434.       Dir_Point     : Dir_Rec;
  435.       Dir_Last      : Dir_Rec;
  436.  
  437.     (* This embedded procedure is called upon to store all of the  *)
  438.     (* directory names in a linear linked list rather than a       *)
  439.     (* B-TREE since it should be rather short and efficiency of    *)
  440.     (* sorting is not an issue.  A bubble sort will be used on it. *)
  441.     procedure Store_Dir_Name;
  442.     var Temp_String : string[15];
  443.         Temp        : byte;
  444.         Index       : byte;
  445.     begin
  446.        Temp := Mem[Seg(Dta):Ofs(Dta) + 21];           (* Attribute *)
  447.        if Temp = $10 then begin (* Pick out directories *)
  448.           Index := 1;
  449.           repeat
  450.              Temp := Mem[Seg(Dta):Ofs(Dta) + 29 + Index];
  451.              if Temp > 0 then
  452.                 Temp_String[Index] := Chr(Temp);
  453.              Index := Index + 1;
  454.           until (Temp = 0) or (Index = 14);
  455.           Temp_String[0] := Chr(Index - 2);
  456.                     (* Directory name found, ignore if it is a '.' *)
  457.           if Temp_String[1] <> '.' then begin
  458.              New(Dir_Point);
  459.              Dir_Point^.Dir_Name := Temp_String;
  460.              Dir_Point^.Next := nil;
  461.              if Dir_Root = nil then
  462.                 Dir_Root := Dir_Point
  463.              else
  464.                 Dir_Last^.Next := Dir_Point;
  465.              Dir_Last := Dir_Point;
  466.           end;
  467.        end;
  468.     end;
  469.  
  470.      (* This is the procedure that sorts the directory names after *)
  471.      (* they are all accumulated.  It uses a bubble sort technique *)
  472.      (* which is probably the most inefficient sort available.  It *)
  473.      (* is perfectly acceptable for what is expected to be a very  *)
  474.      (* short list each time it is called.  More than 30 or 40     *)
  475.      (* subdirectories in one directory would not be good practice *)
  476.      (* but this routine would sort any number given to it.        *)
  477.      procedure Sort_Dir_Names;
  478.      var Change      : byte;
  479.          Save_String : string[15];
  480.          Dir_Next    : Dir_Rec;
  481.      begin
  482.         repeat
  483.            Change := 0;
  484.            Dir_Point := Dir_Root;
  485.            while Dir_Point^.Next <> nil do
  486.               begin
  487.               Dir_Next := Dir_Point^.Next;
  488.               Save_String := Dir_Next^.Dir_Name;
  489.               if Save_String < Dir_Point^.Dir_Name then begin
  490.                  Dir_Next^.Dir_Name := Dir_Point^.Dir_Name;
  491.                  Dir_Point^.Dir_Name := Save_String;
  492.                  Change := 1;
  493.               end;
  494.               Dir_Point := Dir_Point^.Next;
  495.            end;
  496.         until Change = 0;    (* No swaps in this pass, we are done *)
  497.      end;
  498.  
  499. begin
  500.    Count := 0;
  501.    Cluster_Count := 0;
  502.    Dir_Root := nil;
  503.    Mask := Input_Mask + '*.*';
  504.    Mask[Length(Mask) + 1] := Chr(0);    (* A trailing zero for DOS *)
  505.                                    (* Count all files and clusters *)
  506.    repeat
  507.       if Count = 0 then begin         (* Get first directory entry *)
  508.          Recpack.AX := $4E00;
  509.          Recpack.DS := Seg(Mask[1]);
  510.          Recpack.DX := Ofs(Mask[1]);
  511.          Recpack.CX := $17;             (* Attribute for all files *)
  512.          Intr($21,Recpack);
  513.       end
  514.       else begin               (* Get additional directory entries *)
  515.          Recpack.AX := $4F00;
  516.          Intr($21,Recpack);
  517.       end;
  518.       Error := Recpack.AX and $FF;
  519.       if Error = 0 then begin          (* A good filename is found *)
  520.          Count := Count +1;            (* Add one for a good entry *)
  521.  
  522.                            (* Count up the number of clusters used *)
  523.          R1 := Mem[Seg(Dta):Ofs(Dta) + 26];
  524.          R2 := Mem[Seg(Dta):Ofs(Dta) + 27];
  525.          R3 := Mem[Seg(Dta):Ofs(Dta) + 28];
  526.          Real_Size := R3*65536.0 + R2 * 256.0 + R1; (*Nmbr of bytes*)
  527.          R1 := Cluster_Size;
  528.          R1 := Real_Size/R1;                 (* Number of clusters *)
  529.          Index := Trunc(R1);
  530.          R2 := Index;
  531.          if (R1 - R2) > 0.0 then
  532.             Index := Index +1;             (* If a fractional part *)
  533.          Cluster_Count := Cluster_Count + Index;
  534.          if Index = 0 then     (* This is a directory, one cluster *)
  535.             Cluster_Count := Cluster_Count +1;
  536.          Store_Dir_Name;
  537.       end;
  538.    until Error > 0;
  539.    R1 := Cluster_Count;
  540.    R2 := Cluster_Size;
  541.    R1 := R1 * R2;
  542.    Directory_Count := Directory_Count + 1;
  543.    Write('    ',Directory_Count:3,'. ');
  544.    Write(Input_Mask);
  545.    for Index := 1 to (32 - Length(Input_Mask)) do Write(' ');
  546.    Writeln(Count:4,' Files  Cbytes =',R1:9:0);
  547.    if Do_We_Print then begin
  548.       Write(Lst,'    ',Directory_Count:3,'. ');
  549.       Write(Lst,Input_Mask);
  550.       for Index := 1 to (32 - Length(Input_Mask)) do Write(Lst,' ');
  551.       Writeln(Lst,Count:4,' Files  Cbytes =',R1:9:0);
  552.       Count_Print_Lines(1);
  553.    end;
  554.    Total_Cbytes := Total_Cbytes + R1;
  555.    All_Files := All_Files + Count;
  556.  
  557.                            (* files counted and clusters counted   *)
  558.                            (* Now read in only the requested files *)
  559.  
  560.    Count := 0;
  561.    Byte_Count := 0;
  562.    Tree_Root := nil;
  563.    if No_Files_Out <> TRUE then begin
  564.       Mask := Input_Mask + File_Request;
  565.       Mask[Length(Mask) + 1] := Chr(0); (* A trailing zero for DOS *)
  566.       repeat
  567.          New(File_Point);
  568.          if Count = 0 then begin      (* Get first directory entry *)
  569.             Recpack.AX := $4E00;
  570.             Recpack.DS := Seg(Mask[1]);
  571.             Recpack.DX := Ofs(Mask[1]);
  572.             Recpack.CX := $17;          (* Attribute for all files *)
  573.             Intr($21,Recpack);
  574.          end
  575.          else begin            (* Get additional directory entries *)
  576.             Recpack.AX := $4F00;
  577.             Intr($21,Recpack);
  578.          end;
  579.          Error := Recpack.AX and $FF;
  580.          if Error = 0 then begin       (* A good filename is found *)
  581.             Count := Count +1;         (* Add one for a good entry *)
  582.             File_Point^.Left := nil;
  583.             File_Point^.Right := nil;
  584.             for Index := 1 to 23 do
  585.                File_Point^.File_Rec[Index] :=
  586.                            Char(Mem[Seg(Dta):Ofs(Dta) + 20 + Index]);
  587.             if Tree_Root = nil then begin (* Pt to 1st elem in tree*)
  588.                Tree_Root := File_Point;
  589.             end
  590.             else begin     (* Point to additional elements in tree *)
  591.                Position_A_New_Filename(Tree_Root,File_Point);
  592.             end;
  593.  
  594.                               (* Count up the number of bytes used *)
  595.             R1 := File_Point^.File_Size[1];
  596.             R2 := File_Point^.File_Size[2];
  597.             R3 := File_Point^.File_Size[3];
  598.             Real_Size := R3*65536.0 + R2 * 256.0 + R1; (*Number of *)
  599.                                                     (* bytes used. *)
  600.             Byte_Count := Byte_Count + Real_Size;
  601.          end;
  602.       until Error > 0;
  603.    end;
  604.  
  605.    Which_List := Directories;
  606.    if Tree_Root <> nil then
  607.       Print_A_Directory(Tree_Root,Which_List);
  608.    if Tree_Root <> nil then
  609.       Print_A_Directory(Tree_Root,Succ(Which_List));
  610.    if Count > 0 then begin
  611.       Writeln('                  ',Count:5,' Files ',
  612.                                  Byte_Count:17:0,' Bytes');
  613.       Writeln;
  614.       if Do_We_Print then begin
  615.          Writeln(Lst,'                  ',Count:5,' Files ',
  616.                                     Byte_Count:17:0,' Bytes');
  617.          Writeln(Lst);
  618.          Count_Print_Lines(2);
  619.       end;
  620.       Total_Bytes := Total_Bytes + Byte_Count;
  621.       Req_Files := Req_Files + Count;
  622.    end;
  623.                             (* Now go do all of the subdirectories *)
  624.    if Dir_Root <> nil then Sort_Dir_Names;
  625.    Dir_Point := Dir_Root;
  626.    while Dir_Point <> nil do begin
  627.       Mask := Input_Mask + Dir_Point^.Dir_Name + '\';
  628.       Do_A_Directory(Mask);
  629.       Dir_Point := Dir_Point^.Next;
  630.    end;
  631.                            (* Finally, erase the tree and the list *)
  632.    if Tree_Root <> nil then
  633.       Erase_Tree(Tree_Root);
  634.  
  635.    while Dir_Root <> nil do begin
  636.       Dir_Point := Dir_Root^.Next;
  637.       Dispose(Dir_Root);
  638.       Dir_Root := Dir_Point;
  639.    end;
  640. end;
  641.  
  642. (* ******************************************* Output Summary Data *)
  643. procedure Output_Summary_Data;
  644.  
  645. begin
  646.    Writeln;
  647.    Write('                     ',Req_Files:5,' Files');
  648.    Writeln(Total_Bytes:15:0,' Bytes in request');
  649.    Write('                     ',All_Files:5,' Files');
  650.    Writeln(Total_Cbytes:15:0,' Cbytes in tree');
  651.    Write('                                   ');
  652.    R1 := Free_Clusters;
  653.    R2 := Cluster_Size;
  654.    R1 := R1 * R2;
  655.    Writeln(R1:12:0,' Bytes free on disk');
  656.    if Do_We_Print then begin
  657.       Writeln(Lst);
  658.       Write(Lst,'                     ',Req_Files:5,' Files');
  659.       Writeln(Lst,Total_Bytes:15:0,' Bytes in request');
  660.       Write(Lst,'                     ',All_Files:5,' Files');
  661.       Writeln(Lst,Total_Cbytes:15:0,' Cbytes in tree');
  662.       Write(Lst,'                                   ');
  663.       Writeln(Lst,R1:12:0,' Bytes free on disk');
  664.       Count_Print_Lines(4);      (* Signal the end, space paper up *)
  665.    end;
  666. end;
  667.  
  668. begin  (* Main program - Oak Tree ******************************** *)
  669.    Initialize;
  670.    Read_And_Parse_Command_Arguments;
  671.    Print_Header;
  672.    Do_A_Directory(Starting_Path);
  673.    Output_Summary_Data;
  674.    Count_Print_Lines(255);
  675. end.  (* Main Program *)
  676.