ter];
Inc (InCounter);
end;
end;
procedure UnPakByte (P: PCodElement ); p> { --- Розпакування одного байта ---}
Var Mask: word;
begin
If (P ^. P0 = Nil) and (P ^. P1 = Nil) then
begin
OutBuf [OutCounter]: = P ^. Index;
Inc (OutCounter);
Inc (LengthOutFile);
If OutCounter = (SizeOf (OutBuf) -1) then
begin
BlockWrite (InterF, OutBuf, OutCounter, NumWritten);
OutCounter: = 0;
end;
end
else
begin
Inc (CounterBite);
If CounterBite = 9 then
begin
Inc (InCounter);
If InCounter = (SizeOf (InBuf)) then
begin
InCounter: = 0;
BlockRead (OutputF, InBuf, SizeOf (InBuf), NumRead);
end;
CounterBite: = 1;
end;
Mask: = InBuf [InCounter];
Mask: = Mask SHL (CounterBite-1);
Mask: = Mask OR $ FF7F; {установка всіх бітів крім старшого}
If Mask = $ FFFF then UnPakByte (P ^. P1)
else UnPakByte (P ^. P0);
end;
end;
procedure UnPakFile;
{--- розпакування одного файлу ---}
begin
BlockRead (OutputF, InBuf, SizeOf (InBuf), NumRead);
ErrorByte: = IOResult;
ErrorMessage;
If NormalWork then ResetUnPakFiles;
If NormalWork then
begin
RestoryCodeTable;
SortQueueByte;
CreateTree; {створення дерева частот}
CreateCompressCode;
CounterBite: = 0;
OutCounter: = 0;
LengthOutFile: = 0;
While LengthOutFile LengthArcFile do
UnPakByte (Root);
BlockWrite (InterF, OutBuf, OutCounter, NumWritten);
DeleteTree;
DisposeCodeTable;
end;
CloseUnPakFile;
end;
{------------------------- main text -------------------------}
begin
DeleteFile: = False;
NormalWork: = True;
ErrorByte: = 0;
WriteLn;
WriteLn ('ArcHaf version 1.0 (c) Copyright VVS Soft Group, 1992. '); p> ResetArchiv;
If NormalWork then
begin
St: = ParamStr (1);
Case St [1] of
'a', 'A': PakFile;
'm', 'M': begin
DeleteFile: = True;
PakFile;
end;
'e', ​​'E': UnPakFile;
else;
end;
end;
CloseArchiv;
end.
Список літератури
Для підготовки даної роботи були використані матеріали з сайту
