Технический форум
Вернуться   Технический форум > Программирование > Форум программистов > Помощь студентам


Ответ
 
Опции темы Опции просмотра
Старый 26.10.2012, 21:12   #1 (permalink)
lenchik1
Новичок
 
Регистрация: 26.09.2012
Сообщений: 7
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
По умолчанию Алгоритм 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.
помогите найти ошибку(и).программа не хочет запускаться(((
lenchik1 вне форума   Ответить с цитированием

Старый 26.10.2012, 21:12
Helpmaster
Member
 
Аватар для Helpmaster
 
Регистрация: 08.03.2016
Сообщений: 0

Чтобы не тратить время на поиски, отправлю вам сразу похожие обсуждения

Описать алгоритм
Разработать алгоритм удаления из стека
Помогите изменить алгоритм
Алгоритм
Алгоритм с возвратом
Помогите написать алгоритм и блок-схему

Ads

Яндекс

Member
 
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
Ответ

Опции темы
Опции просмотра

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Выкл.
HTML код Выкл.
Trackbacks are Вкл.
Pingbacks are Вкл.
Refbacks are Выкл.




Часовой пояс GMT +4, время: 19:52.

Powered by vBulletin® Version 6.2.5.
Copyright ©2000 - 2014, Jelsoft Enterprises Ltd.