Разработка программы кодирования текстовых файлом методом RLE

Федеральное агентство по образованию

Государственное образовательное  учреждение высшего профессионального  образования

 

 

 

Пояснительная записка

к курсовой работе

 

по дисциплине   «Информационные технологии»

Название работы  «Разработка программы кодирования текстовых       файлом методом RLE»

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

Описание  алгоритма

Кодирование длин серий (англ. Run-length encoding, RLE) или Кодирование повторов — простой алгоритм сжатия данных, который оперирует сериями данных, то есть последовательностями, в которых один и тот же символ встречается несколько раз подряд. При кодировании строка одинаковых символов, составляющих серию, заменяется строкой, которая содержит сам повторяющийся символ и количество его повторов.

Hапpимеp, имеется стpока типа "AAAAABBBCCCADDDEEL". Она запакуется в последовательность типа "5A3B3CADDEEL". Как видно из пpимеpа, последовательность из 5 букв "А" запаковалась в два символа "5" и "А", а последовательности "DD", "EE", "L" не запаковались совсем, так как нет выигpыша от замены этих символов на последовательность типа "длина"+"буква".

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

Текст программы

program rle;

{$APPTYPE CONSOLE}

uses

  SysUtils;

type

  TFile=class

      Fin,Fon:file of byte;

      NameIn,NameOut:string;

      Procedure SetnameIn(s:string);

      Procedure SetnameOut(s:string);

      procedure FOpen;virtual;

      procedure FClose;

      procedure FSet(b:byte);

      function FGet:byte;

      procedure FSeek(b:longint);

      function FPos:longint;

      procedure Left;

      procedure Right;

  end;

  TArch=class(TFile)

      procedure FOpen;override;

      procedure Pak;

      procedure UnPak;

      procedure Run;

  end;

Procedure TFile.SetnameIn(s:string);

begin

  NameIn:=s;

  assign(Fin,NameIn);

end;

Procedure TFile.SetnameOut(s:string);

begin

  NameOut:=s;

  assign(Fon,Nameout);

end;

Procedure TFile.FOpen;

begin

  {$i-}

  reset(Fin);

  if ioresult<>0 then

  begin

    writeln('’ This file  (',NameIn,') not found');

    writeln('Press any Key');

    readln;

    halt;

  end;

  reset(Fon);

  if ioresult<>0 then

  begin

    writeln('This file (',NameOut,') no create');

    writeln('Press any Key');

    readln;

    halt;

  end;

  {$i+}

end;

procedure TFile.FClose;

begin

  {$i-}

    close(Fin);

    close(Fon);

    writeln('Unpak complete');

    readln;

  {$i+}

end;

procedure TFile.FSet(b:byte);

begin

  write(Fon,b);

end;

function TFile.FGet:byte;

var

  b:byte;

begin

  if eof(fin) then

  begin

   close(fin);

   close(fon);

   writeln('Pak complete');

   readln;

   halt;

  end;

  Read(Fin,b);

  FGet:=b;

end;

procedure TFile.FSeek(b:longint);

begin

  seek(Fin,b);

end;

 

function TFile.FPos:longint;

begin

  FPos:=FilePos(Fin);

end;

procedure TFile.Left;

var

  p:longint;

begin

  p:=FPos;

  If p>0 then

    Fseek(p-1);

end;

 

procedure TFile.Right;

var

  p:longint;

begin

  p:=FPos;

  If p<FileSize(Fin) then

    Fseek(p+1);

end;

 

Procedure TArch.FOpen;

begin

  {$i-}

  reset(Fin);

  if ioresult<>0 then

  begin

    writeln('No file (',NameIn,') like that');

    writeln('Press any Key');

    readln;

    halt;

  end;

  {$i+}

  rewrite(Fon);

end;

procedure TArch.Pak;

var

  c,i,ci:byte;

  f: longint;

begin

  while not eof(fin) do

  begin

    c:=FGet;

    i:=0;

    repeat

      ci:=FGet;

      inc(i);

    until ((eof(fin)) or (ci<>c));

    if ci<>c then Left;

    if i>=4 then

      begin

        ci:=255;

        FSet(ci);

        FSet(c);

        FSet(i);

      end

 

    else

        while i>0 do

        begin

          FSet(c);

          dec(i);

        end;

  end;

end;

procedure TArch.UnPak;

var

  c,i:byte;

begin

  while not eof(fin) do

  begin

    c:=FGet;

    if c=255 then

    begin

      c:=FGet;

      i:=FGet;

      while i>0 do

      begin

        FSet(c);

        dec(i);

      end;

    end

    else

      FSet(c);

  end;

end;

procedure TArch.Run;

var

 s:string;

begin

  write('Name input file  =');

  readln(s);

  SetnameIn(s);

  write('Name output file =');

  readln(s);

  SetnameOut(s);

  Fopen;

  write('Pak or UnPak (p/u)');readln(s);

  case s[1] of

    'p':pak;

    'u':UnPak

    else

    begin

      writeln('p or u');

      writeln('Press any Key');

      halt;

    end;

  end;

  FClose;

end;

var

  F:TArch;

begin

  f:=TArch.Create;

  f.run;

end.