The following is some code I've been working on as a toy to learn Pascal.

Enjoy:

 

 

 

program fs;
uses sysutils,strutils,Crt;
{ admin, normal, other }
type
	{ NOT EVEN NEEDED, i'm a tard }
	bootblock = record
		pbs : Array[1..3] of Byte; { 3 bytes }
		omf : Array[1..8] of Byte; { 8 bytes }
		bpb : Word; {bytes per block = 512 }
		bpa : Byte; {blocks per allocation }
		nrb : Word; { number reserved blocks}
		nft : Byte; { number of fat tables }
		nrd : Word; { number of root directory }
		tnb : Word; { total number of blocks }
		mdd : Byte; { media descriptor }
		nbf : Word; { number of blocks per FAT }
		nbt : Word; { blocks per track }
		hed : Word; { heads }
		nhb : LongWord ; { number hidden blocks }
		ttnb : LongWord ; { total number of blocks }
		pdn : Word ; { physical drive number }
		ebr : Byte ; { extended boot record }
		vsn : LongWord ; { volume serial number }
		vlb : Array [1..11] of Byte; { volume label }
		fsi : Array [1..8] of Byte; { File system identifier}	
		rmb : Array [1..448] of Byte; { remaining boot stuff }
		bbs: Word;
	end;

	directory = record
		filename : string ;{Array [1..8] of Char;}
		ext : string; {Array [1..3] of Char;}
		attrib : Byte;
		res : Array [1..10] of Byte;
		time : Word;
		date : word;
		start_cluster: Word;
		file_size : LongWord;
	
	end;

var
	outfile : file of Byte;
	files : file of Byte;
	line : string;
	i : longword;
	bb : Byte;
	fat : string;
	number_of_fats : byte;
	size_of_fats : word;
	root_directory : word;
	bytes_per_block : word;
	max_root_entries : word;
	blocks_per_allocation : byte;
	first_fat : word;
	d,e : directory;
	temp : string;
	fdata : Array of byte;
	fsize : longword;
	cwf : LongWord;
	cwd : LongWord;


{ we assume global files }
{ we also assume we are already at the root directory or some place after }
procedure ReadDirectory(var dir : directory);
var
	i : integer;
	bb : byte;
begin
	{clear directory}
	FillChar(dir,sizeof(dir),0);
	{first let's read in the filename}
	for i := 1 to 8 do
	begin
		read(files,bb);
		{write(ord(bb),' ');}
		dir.filename := dir.filename + chr(bb);
	end;
	
	for i := 1 to 3 do
	begin
		read(files,bb);
		dir.ext := dir.ext + chr(bb);
	end;
	
	read(files,dir.attrib);
	
	if( dir.attrib = $0F ) then 
	begin
		{writeln('this entry is part of VFAT');}
	end;
	
	for i:= 1 to 10 do
	begin
		read(files,bb); { reserved }
	end;
	
	{time}
	read(files,bb);
	read(files,bb);
	{date}
	read(files,bb);
	read(files,bb);
	
	read(files,bb);
	dir.start_cluster := bb;
	read(files,bb);
	dir.start_cluster := dir.start_cluster + (bb << 8);
	
	read(files,bb);
	dir.file_size := bb;
	read(files,bb);
	dir.file_size := dir.file_size + (bb << 8);
	read(files,bb);
	dir.file_size := dir.file_size + (bb << 16);
	read(files,bb);
	dir.file_size := dir.file_size + (bb << 24);
	
	if(dir.attrib = $0F) then
	begin
		ReadDirectory(dir);
	end;		
end;	



{ list contents of current directory }
{ assume we are at the current directory memloc }
procedure dir();
var
	temp : string;
	d : directory;
begin
	Seek(files,0);
	Seek(files,cwd);
	ReadDirectory(d);
	while (d.Filename[1] <> #0) and (d.Filename[1] <> #$e5) and (d.attrib <> $0f) do
	begin
		temp := DelSpace(d.filename);
		{write('###',length(d.ext),'###');}
		if (d.attrib = $22) then
		begin
			ReadDirectory(d);
			continue;
		end;
		if (d.attrib <> $10) and (d.attrib <> $12) and (d.attrib <> $28) then
		begin
			if (length(d.ext) > 0) and (d.ext <> '   ') then
				{writeln('^',ord(d.filename[1]),'***',temp:8,'.',d.ext,d.file_size:10)}
				writeln('***',temp:8,'.',d.ext:3,d.file_size:10)
			else
				{writeln('^',ord(d.filename[1]),'***',temp:8);}
				writeln('***',temp:8);
		end else begin
			if( d.attrib <> $28 ) then
				writeln('d->',temp:8);
		end;
		ReadDirectory(d);
		{ReadKey;}
	end;
end;

{find listing from cwd and cd to next directory}
procedure cd(dd: string);
var
	d : directory;
begin
	writeln('attemping to find ',dd);
	Seek(files,0);
	Seek(files,cwd); { seek CWD }
	ReadDirectory(d);
	while (d.Filename[1] <> #0) and (d.Filename[1] <> #$e5) and (d.attrib <> $0f) do
	begin
		temp := DelSpace(d.filename);
	
		if (d.attrib and $10) = $10 then
		begin
			writeln('directory',temp);
			if (temp = dd) then
			begin
				writeln('found!');
				cwd := (blocks_per_allocation * (d.start_cluster-2) * 512) + (first_fat * 512);
				break;
			end;
		end;
		 	
	
		ReadDirectory(d);
		{ReadKey;}
	end;
end;

procedure read_file(dd: string ; var outsize: longword);
var
	d : directory;
	max_bytes : longword;
	bytes_remain : longword;
	i : longword;
	j : longword;
	b : byte;
	c : word; { the clsuter }
begin
	cwf := 0;
	outsize := 0;
	writeln('attemping to find file ',dd);
	Seek(files,0);
	Seek(files,cwd); { seek CWD }
	ReadDirectory(d);
	while (d.Filename[1] <> #0) and (d.Filename[1] <> #$e5) and (d.attrib <> $0f)  do
	begin
		temp := DelSpace(d.filename);
		temp := temp + '.' + DelSpace(d.ext);
		if ((d.attrib and $10) <> $10)  and (d.attrib <> $28)  then
		begin
			writeln('file ',temp);
			if (temp = dd) then
			begin
				writeln('found! -> size :', d.file_size);
				cwf := (blocks_per_allocation * (d.start_cluster-2) * 512) + (first_fat * 512);
				break;
			end;
		end;
		 	
	
		ReadDirectory(d);
		{ReadKey;}
	end;
	
	if ( cwf > 0 ) then
	begin
		c := d.start_cluster;
		Seek(files,0);
		Seek(files,cwf);
		{ read 512 bytes }
		max_bytes := blocks_per_allocation * 512;
		j := 0; { dynamic arrays are 0 indexed! }
		SetLength(fdata,d.file_size);
		{writeln('fdata size is ', d.file_size + 10);
		writeln('actual fdata ', HIGH(fdata));}
		bytes_remain := d.file_size;
		outsize := d.file_size;
		repeat
			if bytes_remain < blocks_per_allocation * 512 then
				max_bytes := bytes_remain;
			for i:= 1 to max_bytes do
			begin
				read(files,b);
				fdata[j] := b;
				{write(chr(b));}
				j := j + 1;
				{writeln(j,' fdata? ', bytes_remain);}
			end;
			bytes_remain := bytes_remain - max_bytes;
			{writeln('***looking up next cluster last was :', c);}
			Seek(files,512 + c * 2);
			read(files,b);
			c:= b;
			read(files,b);
			c:= c + (b << 8);
			writeln('cluster is ', c);
			if( c = $ffff ) then
				break;
			cwf := (blocks_per_allocation * (c-2) * 512) + ((first_fat) * 512);
			{writeln('going to ',cwf);}
			Seek(files,0);
			Seek(files,cwf);
			
		until bytes_remain <= 0;
		
	end;
end;


procedure del(dd : string);
var
	d : directory;
	max_bytes : longword;
	bytes_remain : longword;
	i : longword;
	j : longword;
	b : byte;
	c : word; { the clsuter }
	pc : word; { last one, so we can clear }
begin
	Seek(files,0);
	Seek(files,cwd); { seek CWD }
	ReadDirectory(d);
	while (d.Filename[1] <> #0) and (d.Filename[1] <> #$e5) and (d.attrib <> $0f)  do
	begin
		temp := DelSpace(d.filename);
		temp := temp + '.' + DelSpace(d.ext);
		if ((d.attrib and $10) <> $10)  and (d.attrib <> $28)  then
		begin
			writeln('file ',temp);
			if (temp = dd) then
			begin
				writeln('found! -> prepping delete:', d.file_size);
				cwf := 1;
				break;
			end;
		end;
		 	
	
		ReadDirectory(d);
		{ReadKey;}
	end;


	{ ok we are a file, let's delete! }
	if ( cwf > 0 ) then
	begin
		c := FilePos(files);
		Seek(files,c-32); {directory - 32}
		write(files,$E5);
		c := d.start_cluster;
		Seek(files,0);
		
		repeat
			pc := c;
			Seek(files,512 + c * 2);
			read(files,b);
			c:= b;
			read(files,b);
			c:= c + (b << 8);
			Seek(files,512 + pc * 2);
			write(files,0);
			write(files,0);
		until c = $ffff;
		
	end;

end;


procedure fwrite(name: string);
var
	i : longword;
	b : byte;
	c : word; { the clsuter }
	pc : word; { last one, so we can clear }
begin
	{ search for open allocation units }
	{ for each open unit, write the next open unit }
	{ go to current unit, write data }
	{ loop }
	
	i := 0;
	repeat
		i := i + 1;
		c := 0;
		read(files,b);
		c := b;
		read(files,b);
		c := c + (b << 8);
	until c = 0;
	writeln('found in cell block ',i);
end;

{load into memory}
begin
	assign(files,'Untitled.dmg');
	assign(outfile,'theoutfile.pas');
	reset(files);
	
	rewrite(outfile);
	i := 0;
	
	Seek(files,$36);
	for i:= 1 to 5 do
	begin
		read(files,bb);
		fat := fat + chr(bb);
	end;
	if fat = 'FAT16' then
	begin
		writeln('Im fat');
		Seek(files,0); {reset}
		Seek(files,$d);
		read(files,blocks_per_allocation);
		Seek(files,$10); { bytes per block }
		read(files,bb);
		number_of_fats := bb;
		Writeln('there are : ', number_of_fats, ' fats');
		read(files,bb);
		max_root_entries := bb;
		read(files,bb);
		max_root_entries := max_root_entries + (bb << 8);
		Seek(files,$16);
		read(files,bb); { read low byte }
		size_of_fats := bb;
		read(files,bb); { high byte }
		size_of_fats := size_of_fats + (bb << 8);
		writeln('size of fats:', size_of_fats);
		root_directory := (size_of_fats * number_of_fats) + 1;
		Seek(files,0);
		Seek(files,$b);
		read(files,bb);
		bytes_per_block := bb;
		read(files,bb);
		bytes_per_block := bytes_per_block + (bb << 8);
		writeln('root at: ',root_directory*bytes_per_block:5);
		writeln('max root entries:',max_root_entries);
		
		first_fat := (32 * max_root_entries) div bytes_per_block;
		first_fat := first_fat + root_directory;
		writeln('fat:', first_fat, ' root',root_directory);
		
		Seek(files,0);
		Seek(files,root_directory*bytes_per_block);
		
		cwd := root_directory*bytes_per_block; { set ourselves to root }
		
		for i := 1 to 5 do
		begin
			ReadDirectory(d);
			FillChar(d,sizeof(d),0);
		end;
		{read(files,bb);}
		writeln(' * ', blocks_per_allocation);
		ReadDirectory(e);
		temp := DelSpace(e.filename);
		writeln('***',temp:8,'.',e.ext,e.file_size:10);
		writeln('*>',(blocks_per_allocation * (e.start_cluster-2) * 512) + (first_fat * 512));
		writeln('<*', 512 + e.start_cluster*2);
		writeln('|*',e.start_cluster);
		{
		ReadDirectory(d);
		ReadDirectory(d);
		
		writeln(e.filename);
		}
		
		writeln('****************');
		dir();
		writeln('****************->');
		cd('TESTDIR');
		cd('CATTLE');
		cd('..');
		dir();
		writeln('---------');
		temp := '';
		
		read_file('P.PY',fsize);
		writeln('returned size ', fsize);
		writeln('found : ', High(fdata));
		del('LTUS.PNG');
		fwrite('hello');
		{for i:= 0 to High(fdata) do
			write(outfile,fdata[i]); 
		writeln('returned size ', fsize);
		writeln(i, ' <- found : ', High(fdata));}
	end;

end.