• Добро пожаловать на компьютерный форум Tehnari.ru. Здесь разбираемся с проблемами ПК и ноутбуков: Windows, драйверы, «железо», сборка и апгрейд, софт и безопасность. Форум работает много лет, сейчас он переехал на новый движок, но старые темы и аккаунты мы постарались сохранить максимально аккуратно.

    Форум не связан с магазинами и сервисами – мы ничего не продаём и не даём «рекламу под видом совета». Отвечают обычные участники и модераторы, которые следят за порядком и качеством подсказок.

    Если вы у нас впервые, загляните на страницу о форуме и правила – там коротко описано, как задать вопрос так, чтобы быстро получить ответ. Чтобы создавать темы и писать сообщения, сначала зарегистрируйтесь, а затем войдите под своим логином.

    Не знаете, с чего начать? Создайте тему с описанием проблемы – подскажем и при необходимости перенесём её в подходящий раздел.
    Задать вопрос Новые сообщения Как правильно спросить
    Если пришли по старой ссылке со старого Tehnari.ru – вы на нужном месте, просто продолжайте обсуждение.

Алгоритм rle

lenchik1

Ученик
Регистрация
26 Сен 2012
Сообщения
7
Реакции
0
Баллы
0
Алгоритм rle

Код:
program Project2;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Windows;

VAR File_In,File_Out:file of byte;
    mn:integer;
    exit_:Char;
    name1,name2:string;

{========================================================================}

procedure Compress(f1,f2:string);  
 
VAR  count, b, value : byte;

BEGIN
 Assign(File_in,f1);
  reset(File_in);
 Assign(File_out,f2);
  rewrite(File_out);
 read(File_in,value);
 count:=1;     
 while not eof(File_in) do
   begin
      read(File_in,b);
     if (value<>b)or(count>=63)then
       begin
        if (count=1)and(value<192) then
         write(File_out,value)
          else begin
            count:=count+192;
            write(File_out, count, value);
            count:=1;
          end;
        value:=b;
       end else inc(count);
   end;
 count:=count+192;
 write(File_out, count, value);
 write(File_out, b);
 close(File_in);
 close(File_out);
END;
{=======================================================================}
Procedure DeCompress(f1,f2:string); 

VAR b,count,i:byte;
 
BEGIN
 Assign(File_out,f2);
  rewrite(File_out);
 Assign(File_in,f1);
  reset(File_in);
 count:=0;
 while not eof(File_in) do
   begin
    read(File_in,b);
     if b>192 then
      begin
       count:=b-192;
       read(File_in,b);
       for i:=1 to count do write(File_out,b);
      end else write(File_out,b);
   end;
 close(File_out);
 close(File_in);
END;
 
{======================================================================}
Procedure Result_1;   
var size:string;
 
BEGIN
  reset(File_in);
  reset(File_out);
  textcolor(10);
  str(FileSize(File_in),size);
  writeln('исходный файл',size);
  GoToXY(26,9);
  str(FileSize(File_out),size);
  GoToXY(26,10);
  writeln('сжатый файл = ',size);
  close(File_in);
  close(File_out)
END;
 
{======================================================================}
Procedure Result_2;
var size:string;
 
BEGIN
  reset(File_in);
  reset(File_out);

  textcolor(10);
  str(FileSize(File_in),size);
  GoToXY(26,9)
  writeln('сжатый файл = ',size);
  str(FileSize(File_out),size);
  GoToXY(26,10)
  writeln('исходный файл = ',size);

  close(File_in);
  close(File_out)
END;
 
{========================================================================}
begin
   SetconsoleCP(1251);
   SetconsoleOutPutCP(1251);
   writeln;
       write('введите имя входного файла ');
       readln(Name1);
       Assign(File_in,Name1);
       Reset(File_in) ;
        if IOResult<>0 then
          begin
               writeln('файл не найден!');
               halt (0);
          end;
       write('введите имя выходного файла ');
       readln(Name2);
       Assign(File_out,Name2);
       rewrite(File_out);
       if Name1<>'' then
             begin
                 Compress(Name1,Name2);
                 gotoXY(28,7)
                 writeln('файл заархивирован!');
                 Result_1;
                 Decompress(Name1,Name2);
                 gotoXY(28,7)
                 writeln('файл разархивирован!');
                 Result_2;

               end;
   readln
  end.

помогите найти ошибку(и).программа не хочет запускаться(((
 
Назад
Сверху