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

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

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

короче мой тебе совет напиши в платном разделе я за 150 р договорился к завтому уже сделают

я сделаю эту программу, только чуть позже, возможно завтра-послезавтра (ну если конечно раньше вдруг никто не сделает).

В 6 бит можно влезть без заглавных русских букв, в 5 вообще никак.. Конечно это если просто делать замену, что не гарантирует максимального сжатия. А так можно и до хафмана дойти, но это уже не так тривиально.

можно без ё

Только если без знаков препинания. С ними число символов зашкалит за 32, и надо будет 6 бит...

Ну в таком случае самый простой выход - задавать через множесто используемый алфавит, считать необходимое колво бит и на них, собственно, делать shr / shl и иже с ними.. Тогда для [а..п,р..я] будет 5 бит, если больше, то больше.

Спасибо, буду ждать. Мне сказали, что можно без "ъ". И в шесть бит было бы хорошо. Спасибо большое если сделаешь...)

И вообще всем СПАСИБО, кто ответил

Дел здесь на час максимум да и кода в полтора экрана.. Поучавствовать не хочешь ? Иначе, если я правильно понял, предлагают в задачи на заказ.

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

Алгоритм простой:
Выбираем используемый алфавит, читаем посимвольно из исходного файла и записаваем порядковые номера символов в конечный файл. Количество бит на представление порядкового номера будет меньше 8-и (6 с твоим алфавитом), чем и достигается сжатие. Единственная сложность - нельзя писать в файл по 6 бит, нужно накапливать результат и скидывать по 8.
Небольшой пример..
Алфавит='0'..'9', необходимое колво бит = 4 (1001-максимальный номер в алфавите), исходная строка='0123456789';
1. результат=0; полезных бит в результате 0
2. читаем символ, результат=0000; полезных бит =4; итоговая строка=''; записать пока нечего..
3 читаем символ, результат=0000 0001; полезных бит =8, пишем.. итоговая строка='0000 0001';
4 читаем символ, результат=0010; полезных бит =4;
5 читаем символ, результат=0010 0011; полезных бит =8, , пишем.. итоговая строка='0000 0001 0010 0011';
Ну и так далее, пока не кончится файл.
SHL понадобится в момент сложения текущего результата с уже накопленным, т.е.
результат=(результат SHL колво_бит) OR текущий_результат;
Вот где то так

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

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.

Спасибо большое) Как нибудь постараюсь отблагодарить