eft;
P: = CurPoint;
CurPoint: = P ^. NewRight;
Dispose (P);
end
else CurPoint: = CurPoint ^. NewRight;
end;
end;
procedure SaveBufHeader;
{--- запис в буфер заголовка архіву ---}
Type
ByteField = array [0 .. 6] of byte;
Const
Header: ByteField = ($ 56, $ 53, $ 31, $ 00, $ 00, $ 00, $ 00);
begin
If Create then
begin
Move (Header, OutBuf [0], 7);
OutCounter: = 7;
end
else
begin
Move (Header [3], OutBuf [0], 4);
OutCounter: = 4;
end;
end;
procedure SaveBufFATInfo;
{ --- Запис в буфер всієї інформації по файлу ---}
Var I: byte;
St: PathStr;
R: SearchRec;
begin
St: = ParamStr (3);
For I: = 0 to Length (St) +1 do
begin
OutBuf [OutCounter]: = byte (Ord (St [I]));
Inc (OutCounter);
end;
FindFirst (St, $ 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 SaveBufCodeArray;
{ --- Зберегти масив частот входжень в архівному файлі ---}
Var I: byte;
begin
For I: = 0 to 255 do
begin
OutBuf [OutCounter]: = Hi (CodeTable [I] ^. CounterEnter);
Inc (OutCounter);
OutBuf [OutCounter]: = Lo (CodeTable [I] ^. CounterEnter);
Inc (OutCounter);
end;
end;
procedure CreateCodeArchiv;
{ --- Створення коду стиснення ---}
begin
InitCodeTable; { ініціалізація кодової таблиці}
CounterNumberEnter; {підрахунок числа входжень байт в блок}
SortQueueByte; {cортировка за зростанням числа входжень}
SaveBufHeader; {зберегти заголовок архіву в буфері}
SaveBufFATInfo; {зберігається FAT інформація по файлу } p> SaveBufCodeArray; {зберегти масив частот входжень в архівному файлі}
CreateTree; {створення дерева частот}
CreateCompressCode; {cоздание коду стиснення}
DeleteTree; {видалення дерева частот}
end;
procedure PakOneByte;
{ --- Стиск і пересилання у вихідний буфер одного байта ---}
Var Mask: word;
Tail: boolean;
begin
CRC: = CRC XOR InBuf [InCounter];
Mask: = CodeTable [InBuf [InCounter]] ^. BiteChain SHR CounterBite;
OutWord: = OutWord OR Mask;
CounterBite: = CounterBite + CodeTable [InBuf [InCounter]] ^. LengthBiteChain;
If CounterBite> 15 then Tail: = True else Tail: = False;
While CounterBite> 7 do
begin
OutBuf [OutCounter]: = Hi (OutWord);
Inc (OutCounter);
If OutCounter = (SizeOf (Ou...
