Архиватор

[В00М]

Есть программный код архиватора, но сама программа тупит в вводе/выводе файла кто может подскажите что не так неделю мучаюсь ничего путного не выходит

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

type
  TArchiveFile  = file of Byte;
   
var
  name , name2 , name3: string;
  f : text;

procedure Archive(name, name2: string);
var
  text_file: Text;
  arch_file: TArchiveFile;

  byte_a, byte_b: Byte;

  archive_byte, left, right: Byte;

  ch: Char;

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

  assign(arch_file, name2);
  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(name2, name3: 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, name2);
  rewrite(txt_file);
  
  reset(arc_file, name3);
 
  rewrite(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);
        write(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
  writeln('Введите путь к файлу: ');
  readln(name);
  writeln('Введите путь, где будет сохранен будущий архив');
  readln(name2);
  writeln('Введите куда разархивируется файл: ');
  readln(name3);
  begin
   Assign(f,name3)
  end;
  Archive(name, name2);
  UnArchive(name2, name3);
  Writeln('Done');
  ReadLn;
end.

[bav03]

строки с 81 по 86 . Перепутаны параметры, вызовы неправильных функций. Может быть отчасти из-за неудачных имен. IMHO лучше вместо name3 было взять что-то типа txt_file_name и т.д.

...
{ }
  begin
 {  assign(txt_file, name2); } assign(txt_file, name3);
    rewrite(txt_file);

 {  reset(arc_file, name3); } assign(arc_file, name2);

 {  rewrite(arc_file); } reset(arc_file);

...
строка 137. write вместо read. Тут, наверное, невнимательность.

        end else begin

          inc(last_readed_byte);
          seek(arc_file, last_readed_byte);
 {         write(arc_file, byte_a); } read(arc_file, byte_a);

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