Переписать все компоненты файла f в файл g, в обратном порядке

for i:=Length(s)-1 downto 1 do
  if s[i]=s[i+1] then begin s[i]:='0'; Delete(s,i+1,1) end;

i:=2; while i<=Length(s) do begin
  if s[i-1]=s[i] then begin
    s[i-1]:='0'; Delete(s,i,1)
  end else inc(i);
end;

'123'#13#10'456'#13#10'789'#13#10

aa1gf

   fg10

var
  f: file of char;
  g: text;
  s: string;
  c: char;
  i: Longint;
begin
  Assign(f, 'in.txt'); Assign(g, 'out.txt');
  Reset(f); Rewrite(g);
  s:='';
  for i:=FileSize(f)-1 downto 0 do begin
    Seek(f, i); Read(f, c);
    case c of
    #13:;
    #10: begin WriteLn(g, s); s:=''; end;
    else if Copy(s, Length(s), 1)=c then s[Length(s)]:='0' else s:=s+c;
    end;
  end;
  Write(g, s);
  Close(f); Close(g);
end.

Program   Name;
uses      crt;
var
         size        : longint;
         fi,fo       : file of char;
         ch,ch1,nul  : char;
         namei,nameo : string;
BEGIN
    ClrScr;nul:='0';
    namei:='f.txt';nameo:='g.txt';
    {$I-}Assign(Fi, Namei);Reset(Fi);{$I+}
    if  (IOResult = 0) then
     begin
       Assign(Fo, Nameo);Rewrite(Fo);
       size:=filesize(fi)-1;
       while size>0 do
        begin
          dec(size,1);seek(fi,size);read(fi,ch1);read(fi,ch);
          if ch<>ch1 then
             begin
               write(fo,ch);
               if size=0 then write(fo,ch1);
             end
                     else
             begin
               dec(size);write(fo,nul);
             end;
        end;
       close(fi);close(fo);
       write('Файл ',nameo,' создан, нажмите любую клавишу...');
     end
                       else
     begin
       writeln('Исходный файл ',namei,' не найден.');
     end;
   readkey;
END.

const
  zero: char = '0';
var
  c, p: char;
  dbl: boolean;
  f, g: file of char;
  i: LongInt;
begin
  Assign(f,'in.bin'); Assign(g,'out.bin');
  Reset(f); Rewrite(g);
  Seek(f,FileSize(f)-1); Read(f,p); dbl:=false;
  for i:=FileSize(f)-2 downto 0 do begin
    Seek(f,i); Read(f,c);
    if dbl then dbl:=false
    else if c<>p then Write(g,p)
    else begin
      Write(g,zero); dbl:=true;
    end; 
    p:=c;
  end;
  if not dbl then Write(g,p);
  Close(f); Close(g);
end.

const
  zero: char = '0';
var
  c, p: char;
  dbl: boolean;
  f, g: file of char;
  i: LongInt;
begin
  Randomize;
  Assign(f,'in.bin'); Assign(g,'out.bin');
  Rewrite(f); Rewrite(g);
  WriteLn('Содержимое "in.bin":');
  for i:=1 to 80*5 do begin
    c:=chr(ord('a')+Random(10)); Write(f,c); Write(c);
  end; WriteLn;
  WriteLn('Содержимое "out.bin":');
  Seek(f,FileSize(f)-1); Read(f,p); dbl:=false;
  for i:=FileSize(f)-2 downto 0 do begin
    Seek(f,i); Read(f,c);
    if dbl then dbl:=false
    else if c<>p then begin Write(g,p); Write(p) end
    else begin
      Write(g,zero); Write(zero); dbl:=true;
    end; 
    p:=c;
  end;
  if not dbl then begin Write(g,p); Write(p) end;
  Close(f); Close(g);
end.