Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 02.03.2012, 20:48   #1
[BeNdeR]
Пользователь
 
Аватар для [BeNdeR]
 
Регистрация: 14.04.2011
Сообщений: 74
По умолчанию Алгоритм Хаффмана

Добрый день программисты! У меня созрел вопрос, который решить с моими навыками сложно, а нужно сделать как можно быстрее! Я пишу архиватор по методу Хаффмана. И вот вопро - как архивировать не один файл а целую группу файлов? Вот кусок кода с архивацией(он для меня сложнават, поэтому если вы знаете, как реализовать его попроще, был бы рад узнать)
Код:
{запись в буфер информации по файлу}
procedure SaveInfo;
Var I : byte;
    S : string;
    R : TSearchRec;
begin
 S:=ExtractFileName(Form1.OpenDialog1.FileName);
 OutBuf[0]:=length(s);
 Inc(OutCounter);
 For I:=1 to Length(S)+1 do
  begin
   OutBuf[OutCounter]:=byte(Ord(S[I]));
   Inc(OutCounter);
  end;
 FindFirst(S,$00,R);
 Dec(OutCounter);
 Move(R.Time,OutBuf[OutCounter],4);
 OutCounter:=OutCounter+4;
 OutBuf[OutCounter]:=R.Attr;
 Move(R.Size,OutBuf[OutCounter+1],4);
 OutCounter:=OutCounter+5;
end;

{сохранить массив частот вхождений в архивном файле}
procedure SaveTable;
Var I : byte;
begin
 For I:=0 to 255 do
  begin
   OutBuf[OutCounter]:=Hi(Table[I]^.Count);
   Inc(OutCounter);
   OutBuf[OutCounter]:=Lo(Table[I]^.Count);
   Inc(OutCounter);
  end;
end;

{создание кода сжатия}
procedure CreateCodeArchiv;
begin
 CreateTable;   { инициализация кодовой таблицы }
 FindVer;       { подсчет числа вхождений байта в блок }
 SortQueueByte; { cортировка по возрастанию числа вхождений }
 SaveInfo;      { сохраняется информация по файлу }
 SaveTable;     { сохранить массив частот вхождений в архивном файле }
 CreateTree;         { создание дерева частот }
 CreateCompressCode; { cоздание кода сжатия }
end;

{сжатие и пересылка в выходной буфер одного байта}
procedure PakOneByte;
Var Mask : word;
    Tail : boolean;
begin
 CRC:=CRC XOR InBuf[InCounter];
 Mask:=Table[InBuf[InCounter]]^.Bites SHR CounterBite;
 OutWord:=OutWord OR Mask;
 CounterBite:=CounterBite+Table[InBuf[InCounter]]^.BitLen;
 If CounterBite>15 then Tail:=True else Tail:=False;
 While CounterBite>7 do
  begin
   OutBuf[OutCounter]:=Hi(OutWord);
   Inc(OutCounter);
   If OutCounter=(SizeOf(OutBuf)-4) then
    begin
     BlockWrite(OutputF,OutBuf,OutCounter,NumWritten);
     OutCounter:=0;
    end;
   CounterBite:=CounterBite-8;
   If CounterBite<>0 then OutWord:=OutWord SHL 8 else OutWord:=0;
  end;
 If Tail then
  begin
   Mask:=Table[InBuf[InCounter]]^.Bites SHL
   (Table[InBuf[InCounter]]^.BitLen-CounterBite);
   OutWord:=OutWord OR Mask;
  end;
 Inc(InCounter);
 If (InCounter=(SizeOf(InBuf))) or (InCounter=NumRead) then
  begin
   InCounter:=0;
   BlockRead(InputF,InBuf,SizeOf(InBuf),NumRead);
  end;
end;

{сжатие файла}
procedure PakFile;
begin
S:=Form1.SaveDialog1.filename;
Assignfile(OutputF, S);
Rewrite(OutputF, 1);
Assignfile(InputF, Form1.OpenDialog1.FileName);
Reset(InputF,1);
application.MessageBox(PChar('Имя файла:  '+ExtractFileName(Form1.OpenDialog1.FileName)),pchar('Упаковка файла'),MB_ICONINFORMATION);
application.MessageBox(PChar('Создание архива '+S),pchar('Упаковка файла'),MB_ICONINFORMATION);
BlockRead(InputF,InBuf,SizeOf(InBuf),NumRead);
OutWord:=0;
CounterBite:=0;
OutCounter:=0;
InCounter:=0;
CRC:=0;
CreateCodeArchiv;
While (NumRead<>0) do PakOneByte;
OutBuf[OutCounter]:=Hi(OutWord);
Inc(OutCounter);
OutBuf[OutCounter]:=CRC;
Inc(OutCounter);
BlockWrite(OutputF,OutBuf,OutCounter,NumWritten);
FreeTable;
Closefile(InputF);
Closefile(OutputF);
end;
Так же прилагаю полный код(естественно код не мой)
Вложения
Тип файла: rar Unit1.rar (3.3 Кб, 25 просмотров)
[BeNdeR] вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Алгоритм Хаффмана [BeNdeR] Мультимедиа в Delphi 12 02.03.2012 20:34
Алгоритм сжатия Хаффмана onryo Общие вопросы Delphi 0 10.04.2011 16:08
алгоритм хаффмана. chuvakner Помощь студентам 4 30.10.2010 23:33
Алгоритм Хаффмана 0479 Помощь студентам 1 15.09.2010 11:53
Алгоритм Хаффмана. Vetal115 Общие вопросы по Java, Java SE, Kotlin 0 22.04.2010 22:23