uses Strings;

const
MAX_TRIES = 50;
BLOCK_SIZE = 4096;

type
block = array [0..BLOCK_SIZE-1] of byte;
blockf = file of block;

VAR
f : blockf;
dum : block;
i : integer;
ext : integer;



{
This procedure opens a new file in the current directory with a unique name.
It tries at most MAX_TRIES different names (extensions). If no unique
name could be generated, the whole program exits.
The file descriptor is passed back in the variable f.
}

procedure tempfile(VAR f : blockf);
var
	retries : integer;
	exts : array [0..8] of char;
	name : string;
	iodum : integer;
begin
	retries := 0;
	randomize;
	repeat
		retries := retries + 1;
		Str(random(999), exts);
		name := 'dummy.' + StrPas(exts);
		assign(f, name);
		{$I-}
		reset(f);
		{$I+}
		iodum := ioresult;
		if (iodum = 0) then
			close(f);
	until (iodum <> 0) OR (retries = MAX_TRIES);

	{
	write('Name: '); writeln(name);
	write('tries: '); writeln(retries);
	}

	if (iodum = 0) then
	begin
		write('Temp file could not be opened after ');
		write(retries);
		writeln(' tries. Exiting.');
		halt(1);
	end;
end;







{
We open a fresh file and write 1024 byte blocks of zeros to it.
If we get an error, the disk is full and all unused space is filled
with zeros. Then we delete the file and exit.
}


BEGIN
	writeln('Nullfile v1.02 by mjordan@code-fu.de');
	writeln('Placed in the Public Domain. Share it! Use on your own risk. No warranty.');
	writeln('');
	writeln('Please run this program after defragmentating your drive.');
	writeln('Nullfile is now writing null characters to a temp file in the current');
	writeln('directory. When the disk is full, the file is automatically deleted.');
	writeln('This is a valuable step before using a cloning utility (like g4u)');
	writeln('that compresses data. Compressing null characters is really fast and makes');
	writeln('for a much smaller image file.');
	writeln('');
	writeln('In case this program doesn''t run under WindowsXP, please move it');
	writeln('to c:\ and rename it to nullfile.exe');
	writeln('');
	writeln('Each dot represents 1 MByte');

	tempfile(f);
	rewrite(f);
	if (ioresult = 0) then
	begin
		for i := 0 to BLOCK_SIZE-1 do dum[i] := 0;
		i := 0;
		repeat
			{$I-}
			write(f, dum);
			{$I+}
			if (i < (1024*1024/BLOCK_SIZE)-1) then
				i := i + 1
			else
			begin
				i := 0;
				write('.');
			end;
		until ioresult <> 0;
	end;
	close(f);
	write('File written');
	erase(f);
	writeln(' and deleted. Happy cloning.');
END.