home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / FRAGS11.ZIP / FRAGS.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1988-06-23  |  13.4 KB  |  386 lines
  1. {Program written by Neil Judell to determine amount of fragmentation on disk.}
  2. {Edited version by Gary Mathews on June 23, 1988}
  3. {Recursively searches root directory, subdirectories, and files for frags.}
  4. {$B-}  {Don't buffer the console}
  5.  
  6. program fats(input,output);
  7. const
  8.      sub_dir = 16;
  9.      dir_entry_size = 32;
  10.      deleted_entry = 'σ';
  11.      alias_entry = '.';
  12.      dir_entry = 16;
  13.      volable = 8;
  14.  
  15. type
  16.      str8 = packed array [0..7] of char;
  17.      str3 = packed array [0..2] of char;
  18.  
  19. {data type defines boot sector data areas}
  20.  
  21.      boot_sector_type = record
  22.                           disk_id   : packed array[0..2] of byte;
  23.                           oem_name  : packed array[0..7] of char;
  24.                           bytes_per_sector    : integer;
  25.                           sectors_per_cluster : byte;
  26.                           reserved_sect       : integer;
  27.                           number_fats         : byte;
  28.                           root_entries        : integer;
  29.                           total_sectors       : integer;
  30.                           media_type          : byte;
  31.                           sectors_per_fat     : integer;
  32.                           sectors_per_track   : integer;
  33.                           number_of_heads     : integer;
  34.                           the_rest  : packed array[0..511] of byte;
  35.                         end;
  36.  
  37. {data type defines directory entries}
  38.  
  39.      dir_entry_type = record
  40.                         fname         : str8;
  41.                         fext          : str3;
  42.                         attr          : byte;
  43.                         reserved      : packed array[0..9] of byte;
  44.                         time          : integer;
  45.                         date          : integer;
  46.                         first_cluster : integer;
  47.                         filesize      : packed array [0..1] of integer;
  48.                       end;
  49.  
  50. {data type needed to pass path to recursive routines}
  51.  
  52.      name_type = string[80];
  53.  
  54. { If we have 12-bit fat entries, we keep 2 sectors of fat in RAM,
  55.   if we have 16-bit fat entries, we keep 1 sector of fat in RAM,
  56.   thus necessitating global definitions of which fat sector we have,
  57.   and global definitions of the fat buffers }
  58.  
  59. var
  60.    fat_sector        : integer;
  61.    fname             : string[80];
  62.    boot_sector       : boot_sector_type;
  63.    i                 : integer;
  64.    root_sector       : integer;
  65.    first_file_sector : integer;
  66.    fat16             : array[0..256] of integer;
  67.    fat12             : array[0..1024] of byte;
  68.    drivelet          : char;
  69.    drivenum          : byte;
  70.  
  71.  
  72. procedure read_sector(sector,segment,offset : integer);
  73. {use interrupt $25 to read absolute disk sector}
  74.  
  75. var
  76.   x : byte;
  77.  
  78. begin
  79.   {First, push bp and ds to preserve them since $25 is a nasty one}
  80.   {then do a popf after the interrupt $25 to preserve the stack}
  81.   {test the carry bit to see if an error, then signal via the x variable}
  82.   {if an error, just croak out}
  83.   Inline(
  84.     $55                         {push bp}
  85.     /$1E                        {push ds}
  86.     /$3E/$A0/>DRIVENUM          {ds: mov al,[<drivenum]}
  87.     /$B9/$01/$00                {mov cx,1}
  88.     /$8B/$96/>SECTOR            {mov dx,>sector[bp]}
  89.     /$8B/$9E/>SEGMENT           {mov bx,>segment[bp]}
  90.     /$8E/$DB                    {mov ds,bx}
  91.     /$8B/$9E/>OFFSET            {mov bx,>offset[bp]}
  92.     /$CD/$25                    {int $25}
  93.     /$72/$05                    {jc  foo}
  94.     /$B0/$00                    {mov al,0}
  95.     /$E9/$02/$00                {jmp foo2}
  96.     /$B0/$01                    {foo: mov al,1}
  97.     /$9D                        {foo2: popf}
  98.     /$1F                        {pop ds}
  99.     /$5D                        {pop bp}
  100.     /$88/$46/<X                 {mov <x[bp],al}
  101.   );
  102.   if x=1 then
  103.    begin
  104.       writeln('Cannot read disk error',Chr(7));
  105.       halt(1);
  106.    end;
  107. end;  {procedure read_sector}
  108.  
  109.  
  110. function cluster_to_sector(cluster : integer): integer;
  111. {translate cluster number to sector number}
  112.  
  113. begin
  114.   cluster_to_sector:=((cluster-2)*boot_sector.sectors_per_cluster)+first_file_sector;
  115. end;  {function cluster_to_sector}
  116.  
  117.  
  118. function next_sector16(sector : integer;var continuous : boolean): integer;
  119. {given a sector number, find the next sector, if the FAT has 16-bit entries}
  120. {return next sector=-1 if end of file}
  121.  
  122. var
  123.   result              : integer;
  124.   oldcluster, cluster : integer;
  125.   new_fat_sector      : integer;
  126.   rsector             : real;
  127.  
  128. begin
  129.   rsector:=sector;
  130.   if rsector<0 then
  131.       rsector:= rsector+65536.0;
  132.   result:= sector+1;
  133.   continuous:= true;
  134.   if ((result-first_file_sector) mod boot_sector.sectors_per_cluster)=0 then
  135.    begin
  136.      cluster:=trunc((rsector-first_file_sector) / boot_sector.sectors_per_cluster);
  137.      cluster:=cluster+2;
  138.      oldcluster:=cluster;
  139.      new_fat_sector:=(cluster*2) div boot_sector.bytes_per_sector;
  140.      if new_fat_sector<>fat_sector then
  141.       begin
  142.        read_sector(new_fat_sector+boot_sector.reserved_sect,seg(fat16),ofs(fat16));
  143.        fat_sector:=new_fat_sector;
  144.       end;
  145.      cluster:= fat16[cluster mod (boot_sector.bytes_per_sector div 2)];
  146.      result:= cluster_to_sector(cluster);
  147.      if (cluster>=-8) and (cluster<=-1) then Result:= -1;
  148.      Continuous:= (result = -1) or (cluster = oldcluster+1)
  149.    end;
  150.    next_sector16:=result;
  151. end;  {function next_sector16}
  152.  
  153.  
  154. function next_sector12(sector : integer;var continuous : boolean): integer;
  155. {given a sector number, find the next sector, if the FAT has 12-bit entries}
  156. {return next sector=-1 if end of file}
  157. var
  158.   result              : integer;
  159.   oldcluster, cluster : integer;
  160.   new_fat_sector      : integer;
  161.   rsector             : real;
  162.  
  163. begin
  164.   rsector:=sector;
  165.   if rsector<0 then
  166.     rsector:=rsector+65536.0;
  167.   result:= sector + 1;
  168.   continuous:=true;
  169.   if ((result-first_file_sector) mod boot_sector.sectors_per_cluster)=0 then
  170.    begin
  171.     cluster:=trunc((rsector-first_file_sector) / boot_sector.sectors_per_cluster);
  172.     cluster:=cluster+2;
  173.     oldcluster:=cluster;
  174.     new_fat_sector:=trunc(cluster*1.5) div boot_sector.bytes_per_sector;
  175.     if new_fat_sector<>fat_sector then
  176.      begin
  177.        read_sector(new_fat_sector+boot_sector.reserved_sect,seg(fat12),ofs(fat12));
  178.        read_sector(new_fat_sector+boot_sector.reserved_sect+1,
  179.          seg(fat12[boot_sector.bytes_per_sector]),ofs(fat12[boot_sector.bytes_per_sector]));
  180.        fat_sector:= new_fat_sector;
  181.      end;
  182.     cluster:=fat12[trunc(oldcluster*1.5) mod boot_sector.bytes_per_sector];
  183.     cluster:=cluster+256*fat12[1+(trunc(oldcluster*1.5) mod boot_sector.bytes_per_sector)];
  184.     if odd(oldcluster)
  185.       then cluster:= (cluster shr 4) and $fff
  186.       else cluster:= cluster and $fff;
  187.     result:= cluster_to_sector(cluster);
  188.     if (cluster >= $FF8) and (cluster >= $FFF) then Result:= -1;
  189.     Continuous:= (result=-1) or (cluster=oldcluster+1)
  190.    end;
  191.    next_sector12:=result;
  192. end;  {function next_sector12}
  193.  
  194.  
  195. function next_sector(sector : integer;var continuous : boolean) : integer;
  196. {get next sector number, by first determining if FAT entries are 12 or}
  197. {16 bits, then calling the appropriate FAT reader}
  198.  
  199. var
  200.   result : integer;
  201.   rsectors : real;
  202.  
  203. begin
  204.   rsectors:= boot_sector.total_sectors;
  205.   if rsectors < 0.0
  206.        then rsectors:=rsectors+65536.0;
  207.   if (rsectors / boot_sector.sectors_per_cluster) > 4087.0
  208.        then result:= next_sector16(sector,continuous)
  209.        else result:= next_sector12(sector,continuous);
  210.   next_sector:= result;
  211. end;  {function next_sector}
  212.  
  213.  
  214. procedure list_file(sector : integer;name : name_type);
  215. {trace through each files sectors, counting fragments as we go}
  216.  
  217. var
  218.   i, j, cluster, osector : integer;
  219.   dir_sector : array[0..31] of dir_entry_type;
  220.   continuous : boolean;
  221.   path,oname : name_type;
  222.  
  223. begin
  224.   i:=0;
  225.   repeat
  226.     sector:= next_sector(sector,continuous);
  227.     if not (continuous) then
  228.         i:= i + 1;
  229.   until (Sector = -1);
  230.   if (i>0) then writeln('file:',name,' fragmented in ',i+1,' pieces');
  231. end;  {procedure list_file}
  232.  
  233.  
  234. procedure makename(var oname : name_type; fname : str8; fext : str3);
  235. {convert DOS directory entry name to more readable format}
  236.  
  237. var
  238.   j : integer;
  239.  
  240. begin
  241.   if fname[0]=chr(5)
  242.     then oname:=chr(229)
  243.     else oname:=fname[0];
  244.   for j:=1 to 7 do
  245.     oname:=oname+fname[j];
  246.   if pos(' ',oname)<>0 then
  247.     delete(oname,pos(' ',oname),length(oname)+1-pos(' ',oname));
  248.   oname:=oname+'.';
  249.   for j:=0 to 2 do
  250.     oname:=oname+fext[j];
  251.   if pos(' ',oname)<>0 then
  252.     delete(oname,pos(' ',oname),length(oname)+1-pos(' ',oname));
  253.   if pos('.',oname)=length(oname) then
  254.     delete(oname,length(oname),1);
  255. end;  {procedure makename}
  256.  
  257.  
  258. procedure list_directory(sector : integer;name : name_type);
  259. {recursively trace out a subdirectory}
  260.  
  261. var
  262.   pieces, i, j, cluster, osector : integer;
  263.   dir_sector       : array[0..31] of dir_entry_type;
  264.   continuous, done : boolean;
  265.   path,oname       : name_type;
  266.  
  267. begin
  268.     {read first sector of directory}
  269.   read_sector(sector,seg(dir_sector),ofs(dir_sector));
  270.   i:=0;  {Keep track of which directory entry we are using}
  271.   done:= false;
  272.   pieces:= 0;  {count fragments as well}
  273.   repeat
  274.     {if directory entry is a subdirectory or a file, do something}
  275.     if (dir_sector[i].fname[0]<>chr(0)) then
  276.      begin
  277.       if (dir_sector[i].fname[0]<>deleted_entry) and
  278.          (dir_sector[i].fname[0]<>alias_entry) and
  279.          (volable <> (dir_sector[i].attr and volable)) then
  280.        begin  {first make the pathname}
  281.         makename(oname,dir_sector[i].fname,dir_sector[i].fext);
  282.         {if subdirectory, go recurse, else just trace file}
  283.         if (dir_entry and dir_sector[i].attr=dir_entry)
  284.           then list_directory(cluster_to_sector(dir_sector[i].first_cluster),name+'\'+oname)
  285.           else list_file(cluster_to_sector(dir_sector[i].first_cluster),name+'\'+oname);
  286.        end;
  287.       i:= i + 1;  {try next dir entry}
  288.       {if no more in this sector, read next directory sector}
  289.       if (i >= boot_sector.bytes_per_sector/dir_entry_size) then
  290.         begin
  291.           i:=0;
  292.           sector:= next_sector(sector,continuous);
  293.           if not (continuous) then pieces:=pieces+1;
  294.           if sector<> -1
  295.             then read_sector(sector,seg(dir_sector),ofs(dir_sector))
  296.             else done:=true;
  297.         end;
  298.      end else done:=true;
  299.   until done;
  300.   if (pieces>0) then writeln('directory:',name,' fragmented in ',pieces+1,' pieces');
  301. end;  {procedure list_directory}
  302.  
  303.  
  304. procedure list_root_directory(sector : integer);
  305. {Identical to list_directory, but the root directory is special because}
  306. {it is guaranteed to be continuous, and its sectors are NOT part of the FAT}
  307.  
  308. var
  309.   i, j, cluster, osector : integer;
  310.   dir_sector : array[0..31] of dir_entry_type;
  311.   done       : boolean;
  312.   oname      : name_type;
  313.  
  314. begin
  315.   read_sector(sector,seg(dir_sector),ofs(dir_sector));
  316.   i:=0;
  317.   done:=false;
  318.   repeat
  319.     if (dir_sector[i].fname[0]<>chr(0)) then
  320.      begin
  321.       if (dir_sector[i].fname[0]<>deleted_entry) and
  322.          (dir_sector[i].fname[0]<>alias_entry) and
  323.          (volable <> (dir_sector[i].attr and volable)) then
  324.        begin
  325.          makename(oname,dir_sector[i].fname,dir_sector[i].fext);
  326.          oname:='\'+oname;
  327.          if (dir_entry and dir_sector[i].attr=dir_entry)
  328.            then list_directory(cluster_to_sector(dir_sector[i].first_cluster),oname)
  329.            else list_file(cluster_to_sector(dir_sector[i].first_cluster),oname);
  330.        end;
  331.       i:=i+1;
  332.       if i>=boot_sector.bytes_per_sector/dir_entry_size
  333.           then
  334.             begin
  335.                i:=0;
  336.                sector:=sector+1;
  337.                read_sector(sector,seg(dir_sector),ofs(dir_sector));
  338.             end;
  339.      end else done:= true;
  340.   until Done;
  341. end;  {procedure list_root_directory}
  342.  
  343.  
  344. begin
  345.      TextBackGround(Blue);
  346.      TextColor(White);
  347.      HiResColor(Blue);
  348.      ClrScr;
  349.      writeln('FRAG V1.1: Search disk for fragmentation');
  350.      writeln;
  351.      write('Drive letter = ');  {get drive letter, convert to drive number}
  352.      read(kbd,drivelet);
  353.      DriveLet:= UpCase(DriveLet);
  354.      writeln(drivelet,':');
  355.      drivenum:= ord(drivelet)-ord('A');
  356.      {tell me that I have not read any FAT sector at all yet}
  357.      fat_sector:= -1;
  358.      read_sector(0,seg(boot_sector),ofs(boot_sector));  {read the boot sector}
  359.  
  360.             {print out disk technical information}
  361.  
  362.      writeln;
  363.      writeln('Logical dimensions:');
  364.      write('   Operating environment:   ');
  365.      for i:= 0 to 7 do
  366.        write(boot_sector.oem_name[i]);
  367.      writeln;
  368.      writeln('   Number of boot sectors:  ',boot_sector.reserved_sect);
  369.      root_sector:= boot_sector.reserved_sect + boot_sector.number_fats *
  370.         boot_sector.sectors_per_fat;
  371.      writeln('   Root directory sectors:  ',root_sector);
  372.      writeln('   Sectors/track:',' ':11,boot_sector.sectors_per_track);
  373.      writeln('   Heads:',' ':19,boot_sector.number_of_heads);
  374.      writeln;
  375.  
  376. {calculate the offset basis for data sectors for cluster<->sector calculations}
  377.  
  378.      first_file_sector:=(boot_sector.root_entries*dir_entry_size) div
  379.        boot_sector.bytes_per_sector;
  380.      first_file_sector:= first_file_sector+boot_sector.reserved_sect;
  381.      first_file_sector:= first_file_sector+boot_sector.sectors_per_fat *
  382.        boot_sector.number_fats;
  383.      list_root_directory(root_sector);  {start looking for fragments}
  384.      TextBackGround(Black);  {Restore screen color}
  385.      HiResColor(Black)
  386. end.  {main}