Помогите написать архиватор для текстовых файлов на паскале, Я на первом курсе очень надо сдать, со кроком уже опаздываю... Помогит Опции

[-Антон-]

Задача такая:

Программа архиватор- разархиватор текстовых файлов на русском языке ( Применяются только буквы русского алфавита, знаки припенания и пробелы, сжатие должно быть максимальным).

Примечание: Мне препод сказал, что как-то надо сделать так, чтобы на символ приходилось не 8 бит, а 5... можно 6. ( Сказал надо использовать SHL и SHR, а я только школу закончил, полтора месяца отучился, что такое бинарные операции и что с ними делать не представляю).

[klem4]

извиняюсь что с опозданием, времени совсем нету свободного в последнее время, вот написал, код конечно грязный, времени для сокращения к сожалению тоже нет, но хоть что-то ... пример файла состоящего из алфавита в аттаче, сжатие

232 байта ----> 174 байта (для прикрепленного файла)

uses crt;

const
  alpha: String = 'abcdefghijklmnopqrstuvwxyz0123456789-.:,;!? '#10#13;

type
  TArchiveFile  = file of Byte;

procedure Archive(const txt_file_name, arc_file_name: String);
var
  text_file: Text;
  arch_file: TArchiveFile;

  byte_a, byte_b: Byte;

  archive_byte, left, right: Byte;

  ch: Char;

begin
  assign(text_file, txt_file_name);
  reset(text_file);

  assign(arch_file, arc_file_name);
  rewrite(arch_file);

  if not eof(text_file)  then begin

    left  := 2;
    right := 4;

    repeat

      if (left = 2) and not eof(text_file) then begin
         read(text_file, ch);
         byte_a := Pos(ch, alpha);
      end else byte_a := byte_b;

      if not eof(text_file) then begin
        read(text_file, ch);
        byte_b := Pos(ch, alpha);
      end else
        byte_b := 0;

      archive_byte := byte(byte_a shl left) or byte(byte_b shr right);

      write(arch_file, archive_byte);

      if left < 6 then
        left := left + 2
      else
        left := 2;

      if right > 0 then
        right := right - 2
      else
        right := 4;

    until eof( text_file );

    if (right <> 4) and (byte_b <> 0) then
     write(arch_file, byte(byte_b shl left));

  end;

  close(text_file);
  close(arch_file);
end;


procedure UnArchive(const arc_file_name, txt_file_name: String);
var
  unarchive_byte, byte_a, byte_b, curr_unbyte_num, bytes_done: Byte;
  txt_file: Text;
  arc_file: TArchiveFile;

  last_readed_byte, file_size: LongInt;

begin
  assign(txt_file, txt_file_name);
  rewrite(txt_file);

  assign(arc_file, arc_file_name);
  reset(arc_file);

  curr_unbyte_num := 0;
  last_readed_byte := -1;
  bytes_done := 0;

  repeat

    inc(bytes_done);

    if curr_unbyte_num < 4 then
     inc(curr_unbyte_num)
    else
     curr_unbyte_num := 1;

    if curr_unbyte_num = 4 then begin

      seek(arc_file, last_readed_byte);
      read(arc_file, byte_a);

      unarchive_byte := byte(byte(byte_a shl 2) shr 2);

    end else if curr_unbyte_num = 3 then begin

      seek(arc_file, last_readed_byte);
      read(arc_file, byte_a);

      seek(arc_file, last_readed_byte + 1);
      read(arc_file, byte_b);

      unarchive_byte := byte(byte(byte_a shl 4) shr 2) + byte(byte_b shr 6);

      inc(last_readed_byte);

     end else if curr_unbyte_num = 2 then begin

       seek(arc_file, last_readed_byte);
       read(arc_file, byte_a);

       seek(arc_file, last_readed_byte + 1);
       read(arc_file, byte_b);

       unarchive_byte := byte(byte(byte_a shl 6) shr 2) + byte(byte_b shr 4);

       inc(last_readed_byte);

      end else begin

        inc(last_readed_byte);
        seek(arc_file, last_readed_byte);
        read(arc_file, byte_a);

        unarchive_byte := byte(byte_a shr 2);
      end;

      if unarchive_byte <> 0 then
       write(txt_file, alpha[unarchive_byte]);

  until bytes_done = 8 * (filesize(arc_file)) div 6;

  close(txt_file);
  close(arc_file);
end;

begin
  Archive('c:\text.txt', 'c:\archive.arc');
  UnArchive('c:\archive.arc', 'c:\text1.txt');
  Writeln('Done');
  ReadLn; 
end.