Символьный файл содержит пробелы. Сжать этот файл (убрать пробелы)

uses crt;
var f:file of char;
    a:char;
    n,i,j,k:integer;
begin
clrscr;
randomize;
assign(f,'file1');
rewrite(f);
write('Количество символов n=');
readln(n);
writeln('Введите ',n,' символов, в том числе пробелы');
for i:=1 to n do
 begin
  write('символ ',i,'=');
  readln(a);
  write(f,a);
 end;
writeln('Исходный файл:');
reset(f);
while not eof(f) do
 begin
  read(f,a);
  write(a,' ');
 end;
writeln;
close(f);
reset(f);
k:=0;i:=0;
while i<=filesize(f)-2-k do{проверяем до предпоследнего}
  begin
  seek(f,i);
  read(f,a);
  if a=' ' then{если пробел}
   begin
    k:=k+1;{считаем}
    for j:=i to filesize(f)-2 do{сдвигаем конец файла на 1 вверх}
     begin
      seek(f,j+1);
      read(f,a);
      seek(f,j);
      write(f,a);
    end;
   end
  else i:=i+1;
 end;
seek(f,filesize(f)-k-1);{проверяем последний из неудаленных}
read(f,a);
if a=' ' then k:=k+1;{если пробел, добавляем удаленных}
seek(f,filesize(f)-k);{встаем в последний}
truncate(f);{обрезаем файл}
close(f);
reset(f);
if filesize(f)=0 then write('Все элементы удалены')
else
 begin
  writeln('Измененный файл:');
  reset(f);
  for i:=0 to filesize(f)-1 do
   begin
    read(f,a);
    write(a,' ');
   end;
 end;
close(f);
readln
end.

var f:file of char;
a:char;
n,i:integer;
begin
assign(f,'file1');
rewrite(f);
write('Количество символов n=');
readln(n);
writeln('Введите ',n,' символов, в том числе пробелы');
for i:=1 to n do
begin
write('символ ',i,'=');
readln(a);
write(f,a);
end;
writeln('Исходный файл:');
reset(f);
while not eof(f) do
begin
read(f,a);
write(a,' ');
end;
end.

var f:file of char;
a:char;
n,i:integer;
begin
...........
end.

Program My10;
{ Символьный файл содержит пробелы. Сжать этот файл (убрать пробелы). }
uses 
  crt;
var 
  f:file of char;
  a:char;
  n,i,j,k:integer;
  s: string;
begin
  clrscr;
  assign(f,'file1');
  rewrite(f);
 
  write('Количество символов n=');
  readln(n);
  for i:= 1 to n do
    begin
      readln(a);
      write(f,a);
    end;
 
  writeln('Исходный файл:');
  seek(f,0);
  while not eof(f) do
    begin
      read(f,a);
      write(a);
    end;
  writeln;
 
  n:= filesize(f);
  i:=0;
  j:=0;
  
  while i<n do{проверяем до последнего}
    begin
      seek(f,i);
      read(f,a);
      if a<>' ' then{если не пробел}
        begin
          seek(f,j);
          write(f,a);
          inc(j);
        end;
      inc(i);
    end;
  truncate(f);{обрезаем файл}
 
  seek(f,0);
  if eof(f) then 
    write('Все элементы удалены')
  else
    begin
      writeln('Измененный файл:');
      for i:=0 to filesize(f)-1 do
        begin
          read(f,a);
          write(a);
        end;
    end;
  writeln;
  close(f);
  readln
end.