Category : Utilities for DOS and Windows Machines
Archive   : FRAGS.ZIP
Filename : FRAGS.PAS

{program written by Neil Judell to determine amount of fragmentation on disk}
{recursively searches root directory, subdirectories, files for frags}
{$B-}
{Don't buffer the console}
program fats(input,output);

const
sub_dir = 16;
dir_entry_size = 32;
deleted_entry = 'å';
alias_entry = '.';
dir_entry = 16;
volable = 8;

type
str8 = packed array [0..7] of char;
str3 = packed array [0..2] of char;

{data type defines boot sector data areas}

boot_sector_type = record
disk_id : packed array[0..2] of byte;
oem_name : packed array[0..7] of char;
bytes_per_sector : integer;
sectors_per_cluster : byte;
reserved_sect : integer;
number_fats : byte;
root_entries : integer;
total_sectors : integer;
media_type : byte;
sectors_per_fat : integer;
sectors_per_track : integer;
number_of_heads : integer;
the_rest : packed array[0..511] of byte;
end;

{dat type defines directory entries}

dir_entry_type = record
fname : str8;
fext : str3;
attr : byte;
reserved : packed array[0..9] of byte;
time : integer;
date : integer;
first_cluster : integer;
filesize : packed array [0..1] of integer;
end;

{data type needed to pass path to recursive routines}

name_type = string[80];

{if we have 12-bit fat entries, we keep 2 sectors of fat in ram,
if we have 16-bit fat entries, we keep 1 sector of fat in ram,
thus necessitating global definitions of which fat sector we have,
and global definitions of the fat buffers }

var
fat_sector : integer;
fname : string[80];
boot_sector : boot_sector_type;
i : integer;
root_sector : integer;
first_file_sector : integer;
fat16 : array[0..256] of integer;
fat12 : array[0..1024] of byte;
drivenum : byte;

{use interrupt $25 to read absolute disk sector}
procedure read_sector(sector,segment,offset : integer);

var
x : byte;

begin
{first, push bp and ds to preserve them since $25 is a nasty one}
{then do a popf after the interrupt $25 to preserve the stack}
{test the carry bit to see if an error, then signal via the x variable}
{if an error, just croak out}
Inline(
$55 {push bp}
/$1E {push ds}
/$3E/$A0/>DRIVENUM {ds: mov al,[ /$B9/$01/$00 {mov cx,1}
/$8B/$96/>SECTOR {mov dx,>sector[bp]}
/$8B/$9E/>SEGMENT {mov bx,>segment[bp]}
/$8E/$DB {mov ds,bx}
/$8B/$9E/>OFFSET {mov bx,>offset[bp]}
/$CD/$25 {int $25}
/$72/$05 {jc foo}
/$B0/$00 {mov al,0}
/$E9/$02/$00 {jmp foo2}
/$B0/$01 {foo: mov al,1}
/$9D {foo2: popf}
/$1F {pop ds}
/$5D {pop bp}
/$88/$46/ );
if x=1 then begin
writeln('Cannot read disk');
halt(1);
end;
end;

function cluster_to_sector(cluster : integer) : integer;
{translate cluster number to sector number}

begin
cluster_to_sector:=((cluster-2)*boot_sector.sectors_per_cluster)+first_file_sector;
end;

function next_sector16(sector : integer;var contiguous : boolean) : integer;
{given a sector number, find the next sector, if the FAT has 16-bit entries}
{return next sector=-1 if end of file}

var
result : integer;
oldcluster, cluster : integer;
new_fat_sector : integer;
rsector : real;

begin
rsector:=sector;
if rsector<0 then rsector:=rsector+65536.0;
result:=sector+1;
contiguous:=true;
if ((result-first_file_sector) mod boot_sector.sectors_per_cluster)=0 then begin
cluster:=trunc((rsector-first_file_sector) / boot_sector.sectors_per_cluster);
cluster:=cluster+2;
oldcluster:=cluster;
new_fat_sector:=(cluster*2) div boot_sector.bytes_per_sector;
if new_fat_sector<>fat_sector then begin
read_sector(new_fat_sector+boot_sector.reserved_sect,seg(fat16),ofs(fat16));
fat_sector:=new_fat_sector;
end;
cluster:=fat16[cluster mod (boot_sector.bytes_per_sector div 2)];
result:=cluster_to_sector(cluster);
if cluster=-1 then result:=-1;
if cluster=-2 then result:=-1;
if cluster=-3 then result:=-1;
if cluster=-4 then result:=-1;
if cluster=-5 then result:=-1;
if cluster=-6 then result:=-1;
if cluster=-7 then result:=-1;
if cluster=-8 then result:=-1;
if (result=-1) or (cluster=oldcluster+1) then
contiguous:=true
else
contiguous:=false;
end;
next_sector16:=result;
end;

function next_sector12(sector : integer;var contiguous : boolean) : integer;
{given a sector number, find the next sector, if the FAT has 12-bit entries}
{return next sector=-1 if end of file}
var
result : integer;
oldcluster, cluster : integer;
new_fat_sector : integer;
rsector : real;

begin
rsector:=sector;
if rsector<0 then rsector:=rsector+65536.0;
result:=sector+1;
contiguous:=true;
if ((result-first_file_sector) mod boot_sector.sectors_per_cluster)=0 then begin
cluster:=trunc((rsector-first_file_sector) / boot_sector.sectors_per_cluster);
cluster:=cluster+2;
oldcluster:=cluster;
new_fat_sector:=trunc(cluster*1.5) div boot_sector.bytes_per_sector;
if new_fat_sector<>fat_sector then begin
read_sector(new_fat_sector+boot_sector.reserved_sect,seg(fat12),ofs(fat12));
read_sector(new_fat_sector+boot_sector.reserved_sect+1,
seg(fat12[boot_sector.bytes_per_sector]),ofs(fat12[boot_sector.bytes_per_sector]));
fat_sector:=new_fat_sector;
end;
cluster:=fat12[trunc(oldcluster*1.5) mod boot_sector.bytes_per_sector];
cluster:=cluster+256*fat12[1+(trunc(oldcluster*1.5) mod boot_sector.bytes_per_sector)];
if odd(oldcluster) then
cluster:= (cluster shr 4) and $fff
else
cluster:= cluster and $fff;
result:=cluster_to_sector(cluster);
if cluster=$FFF then result:=-1;
if cluster=$FFE then result:=-1;
if cluster=$FFD then result:=-1;
if cluster=$FFC then result:=-1;
if cluster=$FFB then result:=-1;
if cluster=$FFA then result:=-1;
if cluster=$FF9 then result:=-1;
if cluster=$FF8 then result:=-1;
if (result=-1) or (cluster=oldcluster+1) then
contiguous:=true
else
contiguous:=false;
end;
next_sector12:=result;
end;

function next_sector(sector : integer;var contiguous : boolean) : integer;
{get next sector number, by first determining if FAT entries are 12 or}
{16 bits, then calling the appropriate FAT reader}

var
result : integer;
rsectors : real;

begin
rsectors:=boot_sector.total_sectors;
if rsectors<0.0 then rsectors:=rsectors+65536.0;
if (rsectors / boot_sector.sectors_per_cluster) > 4087.0 then
result:=next_sector16(sector,contiguous)
else
result:=next_sector12(sector,contiguous);
next_sector:=result;
end;

procedure list_file(sector : integer;name : name_type);
{trace through each files sectors, counting fragments as we go}

var
i, j, cluster, osector : integer;
dir_sector : array[0..31] of dir_entry_type;
contiguous, done : boolean;
path,oname : name_type;

begin
i:=0;
done:=false;
while not(done)do begin
sector:=next_sector(sector,contiguous);
if not(contiguous) then i:=i+1;
if sector = -1 then done:=true;
end;
if (i>0) then writeln('file:',name,' fragmented in ',i+1,' pieces');
end;

procedure makename(var oname : name_type;fname : str8;fext : str3);
{convert DOS directory entry name to more readable format}

var
j : integer;

begin
if fname[0]=chr(5) then
oname:=chr(229)
else
oname:=fname[0];
for j:=1 to 7 do oname:=oname+fname[j];
if pos(' ',oname)<>0 then
delete(oname,pos(' ',oname),length(oname)+1-pos(' ',oname));
oname:=oname+'.';
for j:=0 to 2 do oname:=oname+fext[j];
if pos(' ',oname)<>0 then
delete(oname,pos(' ',oname),length(oname)+1-pos(' ',oname));
if pos('.',oname)=length(oname) then delete(oname,length(oname),1);
end;

procedure list_directory(sector : integer;name : name_type);
{recursively trace out a subdirectory}

var
pieces, i, j, cluster, osector : integer;
dir_sector : array[0..31] of dir_entry_type;
contiguous, done : boolean;
path,oname : name_type;

begin
{read first sector of directory}
read_sector(sector,seg(dir_sector),ofs(dir_sector));
{i keeps track of which directory entry we are using}
i:=0;
done:=false;
{count fragments as well}
pieces:=0;
while not(done)do begin
{if directory entry is a subdirectory or a file, do something}
if (dir_sector[i].fname[0]<>chr(0)) then begin
if (dir_sector[i].fname[0]<>deleted_entry) and
(dir_sector[i].fname[0]<>alias_entry) and
(volable <> (dir_sector[i].attr and volable)) then begin
{first make the pathname}
makename(oname,dir_sector[i].fname,dir_sector[i].fext);
{if subdirectory, go recurse, else just trace file}
if (dir_entry and dir_sector[i].attr=dir_entry) then begin
list_directory(cluster_to_sector(dir_sector[i].first_cluster),name+'\'+oname);
end else begin
list_file(cluster_to_sector(dir_sector[i].first_cluster),name+'\'+oname);
end;
end;
{try next dir entry}
i:=i+1;
{if no more in this sector, read next directory sector}
if i>=boot_sector.bytes_per_sector/dir_entry_size then begin
i:=0;
sector:=next_sector(sector,contiguous);
if not(contiguous) then pieces:=pieces+1;
if sector<> -1 then
read_sector(sector,seg(dir_sector),ofs(dir_sector))
else
done:=true;
end;
end else done:=true;
end;
if (pieces>0) then writeln('directory:',name,' fragmented in ',pieces+1,'pieces');
end;

procedure list_root_directory(sector : integer);
{identical to list_directory, but the root directory is special because}
{It is guaranteed to be contiguous, and its sectors are NOT part of the FAT}

var
i, j, cluster, osector : integer;
dir_sector : array[0..31] of dir_entry_type;
done : boolean;
oname : name_type;

begin
read_sector(sector,seg(dir_sector),ofs(dir_sector));
i:=0;
done:=false;
while not(done)do begin
if (dir_sector[i].fname[0]<>chr(0)) then begin
if (dir_sector[i].fname[0]<>deleted_entry) and
(dir_sector[i].fname[0]<>alias_entry) and
(volable <> (dir_sector[i].attr and volable)) then begin
makename(oname,dir_sector[i].fname,dir_sector[i].fext);
oname:='\'+oname;
if (dir_entry and dir_sector[i].attr=dir_entry) then begin
list_directory(cluster_to_sector(dir_sector[i].first_cluster),oname);
end else begin
list_file(cluster_to_sector(dir_sector[i].first_cluster),oname);
end;
end;
i:=i+1;
if i>=boot_sector.bytes_per_sector/dir_entry_size then begin
i:=0;
sector:=sector+1;
read_sector(sector,seg(dir_sector),ofs(dir_sector));
end;
end else done:=true;
end;
end;

var
drivelet : char;

begin
{get drive letter, convert to drive number}
write('Drive letter=');
read(kbd,drivelet);
writeln(drivelet);
if drivelet in ['a'..'z'] then drivelet:=chr(ord('A')+ord(drivelet)-ord('a'));
drivenum:=ord(drivelet)-ord('A');
{tell me that I have not read any FAT sector at all yet}
fat_sector:=-1;
{read the boot sector}
read_sector(0,seg(boot_sector),ofs(boot_sector));
{print out some of the pertinent information}
write('oem name=');
for i:=0 to 7 do write(boot_sector.oem_name[i]);
writeln;
writeln('number of boot sectors=',boot_sector.reserved_sect);
root_sector:=boot_sector.reserved_sect+boot_sector.number_fats*
boot_sector.sectors_per_fat;
writeln('root directory sector=',root_sector);
writeln('sectors/track=',boot_sector.sectors_per_track);
writeln('heads=',boot_sector.number_of_heads);
{calculate the offset basis for data sectors for cluster<->sector calculations}
first_file_sector:=(boot_sector.root_entries*dir_entry_size) div
boot_sector.bytes_per_sector;
first_file_sector:=first_file_sector+boot_sector.reserved_sect;
first_file_sector:=first_file_sector+boot_sector.sectors_per_fat *
boot_sector.number_fats;
{and start looking for fragments}
list_root_directory(root_sector);
end.