Добрый день программисты! У меня созрел вопрос, который решить с моими навыками сложно, а нужно сделать как можно быстрее! Я пишу архиватор по методу Хаффмана. И вот вопро - как архивировать не один файл а целую группу файлов? Вот кусок кода с архивацией(он для меня сложнават, поэтому если вы знаете, как реализовать его попроще, был бы рад узнать)
Код:
{запись в буфер информации по файлу}
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;
Так же прилагаю полный код(естественно код не мой)