home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / ARCTREE.ZIP / ARCTREE.PAS
Encoding:
Pascal/Delphi Source File  |  1988-07-19  |  4.3 KB  |  161 lines
  1. Program ArcTree;
  2. {
  3.  Author           : E. J. Devin
  4.                     10 Morningside Drive
  5.                     Dover, MA 02030
  6.                     on BCS BBS 332-5584 as Edward Devin
  7.  
  8.  Date             : 7/18/88
  9.  Comments         : The Reason for this code was to play with the
  10.                     the built in disk functions in Turbo Pascal 4.0
  11.                     This code runs well enough to give you a good
  12.                     idea of how to use the fucntions
  13.                     Any extra code or declarations should be ignored
  14.                     as it is for a extended version of this program
  15.  
  16. }
  17.  
  18.  
  19.  
  20.  
  21.  
  22.  
  23. uses dos,crt;
  24.  
  25. Type
  26.  
  27.     Dir_point   =  ^dir_type;
  28.     dir_type    =  Record
  29.                      entry_type   : byte;
  30.                      attr         : byte;
  31.                      time         : longint;
  32.                      size         : longint;
  33.                      name         : string[12];
  34.                      next         : dir_point;
  35.                      dir          : dir_point;
  36.                    end;
  37.     str256      =  string[120];
  38.     str12       =  string[12];
  39.  
  40.  
  41. var
  42.    Root,pt1,pt2,pt3                  : Dir_point;
  43.    Dir_info                          : SearchRec;
  44.    x,dirs                            : integer;
  45.    filesize,filed                  : longint;
  46.    s                         : char;
  47.    one                               : boolean;
  48.  
  49. Procedure get_it(path: str256; files:str12; extra:str256; rt:boolean);
  50.  
  51. var
  52.     finfo:searchrec;
  53.     firsttwo:integer;
  54.     fdate:datetime;
  55.     ffiles:str12;
  56.  
  57. Begin
  58.      firsttwo:=1;
  59.      if files <> '*.*' then
  60.      begin
  61.           ffiles:=files;
  62.           files:='*.*';
  63.      end;
  64.      findfirst(path+files,anyfile,finfo);
  65.      while doserror = 0 do
  66.      begin
  67.           firsttwo:=firsttwo+1;
  68.           if x > 22 then
  69.           begin
  70.                write('hit key to continue');
  71.                readln;
  72.                x:=0;
  73.                clrscr;
  74.           end;
  75.           if ((firsttwo > 3) or rt) then
  76.           begin
  77.                x:=x+1;
  78.                unpacktime(finfo.time,fdate);
  79.                if ((finfo.size = 0) and one) then
  80.                begin
  81.                    one:=false;
  82.                    write('\');
  83.                end
  84.                else write(extra+finfo.name,'  ');
  85.                if ((finfo.size = 0) and (not one)) then
  86.                   write(' <DIR>');
  87.                if (finfo.size > 0) then
  88.                write(fdate.month,'/'
  89.                             ,fdate.day,'/'
  90.                             ,fdate.year,'  '
  91.                              ,fdate.hour,':'
  92.                             ,fdate.min,':'
  93.                             ,fdate.sec,'   '
  94.                             ,finfo.size,' bytes');
  95.                writeln;
  96.           end;
  97.           if (((finfo.attr = 16) and (firsttwo > 3)) or rt) then
  98.           begin
  99.              get_it(path+finfo.name+chr(92),files,extra+chr(179)+' ',false);
  100.              dirs:=dirs+1;
  101.           end;
  102.           filesize:=filesize+finfo.size;
  103.           filed:=filed+1;
  104.           findnext(finfo);
  105.     end;
  106. end;
  107. Procedure rget_it(path:str256;files:str12; extra:str256);
  108.  
  109. var
  110.     finfo:searchrec;
  111.     firsttwo:integer;
  112.  
  113. Begin
  114.      firsttwo:=1;
  115.      findfirst(path+files,anyfile,finfo);
  116.      while doserror = 0 do
  117.      begin
  118.           new(pt1);
  119.           firsttwo:=firsttwo+1;
  120.           x:=x+1;
  121.           if ((finfo.attr = 16) and
  122.               (firsttwo > 3)) then
  123.               begin
  124.                 get_it(path+finfo.name+chr(92),files,extra+chr(179)+' ',false);
  125.                 dirs:=dirs+1;
  126.               end;
  127.           findnext(finfo);
  128.  
  129.     end;
  130. end;
  131.  
  132. Begin
  133.  
  134.     x:=0;
  135.     filesize:=0;
  136.     filed:=0;
  137.     dirs:=0;
  138.     root:=nil;
  139.     pt3:=root;
  140.     textmode(co80);
  141.     directvideo:=true;
  142.     one:=true;
  143.     clrscr;
  144.     get_it(chr(92),'*.*',chr(179)+' ',true);
  145.     writeln('strike key to continue');
  146.     repeat
  147.     until keypressed;
  148.     s:=readkey;
  149.     clrscr;
  150.     filed:=filed-((dirs-1)*3);
  151.     writeln('the total number of directories was    :',dirs);
  152.     writeln('the total number of files was          :',filed);
  153.     writeln(' the average file size is              :',(round(filesize/filed)):20);
  154.     writeln('the total number of bytes in files is  :',filesize);
  155.     writeln('the total free space on the disk is    :',diskfree(0));
  156.     writeln('the total size of the disk is          :',disksize(0));
  157.     writeln('the percentage of the disk used is     :',
  158.         (((disksize(0)-diskfree(0))
  159.                      /disksize(0))
  160.                      *100):10:2,' %');
  161. end.