Архиватор

  If Result<0 Then Result:=-1024;

End;

Procedure ProcessNewByte(Var InpWord:TSingleWord; NewChar:Byte; Var OutN:Integer);

Var

  NewW:TSingleWord;

Begin

  NewW:=InpWord;

 {Если строка уже слишком длинная}

  If AddCharToWord(NewW, NewChar)<0 Then

  Begin

    OutN:=FindInDic(NewW);  //запишем эту строку

    ClearWord(InpWord);

    AddCharToWord(InpWord, NewChar);  //Изменим вх. слово

    Exit;

  End;

  OutN:=FindInDic(NewW);

  If OutN>=-256 Then  //если есть в словаре

  Begin  //то ничего не делаем

    OutN:=-1024;

    InpWord:=NewW;  //Изменим вх. слово

  End

  Else Begin //Если нет в словаре, то...

    Dic.Add(NewW);  //добавим новую строку в словарь

    OutN:=FindInDic(InpWord);  //а на выход пошлем пред. строку

    ClearWord(InpWord);

    AddCharToWord(InpWord, NewChar);  //Изменим вх. слово

  End;

End;

Procedure ProcessCompression;

Var

  SrcWord:TSingleWord;

  NewByte:Byte;

  OutN:Integer;

Begin

  NowBitsForDic:=ConstBitsForDic;

  If ReadStream.FileRead Then Exit;

  ClearWord(SrcWord);

  NewByte:=ReadStream.Read(8);

  AddCharToWord(SrcWord, NewByte);

  While Not(ReadStream.FileRead) Do

  Begin

    NewByte:=ReadStream.Read(8);

    ProcessNewByte(SrcWord, NewByte, OutN);

    WriteByDic(OutN);

  End;

  OutN:=FindInDic(SrcWord);

  WriteByDic(OutN);

  WriteStream.Write(0, 8-WriteStream.AdditionalBits+8);

End;

Function CompressFile(SrcFile, DestFile:String):Integer;

Var

  FSize:Integer;

Begin

  Result:=0;  Dic.Clear;

  ReadStream.OpenStream(SrcFile);

  WriteStream.OpenStream(DestFile);

  FSize:=ReadStream.Size;

  WriteFileName(SrcFile, FSize);

  ProcessCompression;

  ReadStream.CloseStream;

  WriteStream.CloseStream;

End;

Function ReadFileName(Var FSize:Integer):String;

Var

  Len, i:Word;

  Tmp:Integer;

Begin

  Result:='';

  FSize:=0;

  Len:=ReadStream.Read(16);

  For i:=1 To Len Do

    Result:=Result+Char(ReadStream.Read(8));

  ReadStream.Read(8);

  FSize:=ReadStream.Read(16);

  Tmp:=ReadStream.Read(16);

  Tmp:=Tmp ShL 16;

  FSize:=Tmp+FSize;

  ReadStream.Read(16);

End;

Procedure SaveSingleWord(SingleWord:TSingleWord);

Var

  i:Word;

  Tmp:Byte;

Begin

  If GetWordLength(SingleWord)=0 Then Exit;

  For i:=1 To GetWordLength(SingleWord) Do

  Begin

    Tmp:=Byte(SingleWord[i]);

    WriteStream.Write(Tmp, 8);

  End;

End;

Procedure WriteByDicOrig(N:Integer);

Var

  Data:Word;

  SrcWord:TSingleWord;

Begin

  If N<-256 Then Exit;

  Data:=Abs(N);

  If N<0 Then

  Begin

    Dec(Data);

    WriteStream.Write(Data, 8);

  End

  Else Begin

    SrcWord:=Dic.Words[Data];

    SaveSingleWord(SrcWord);

  End;

End;

Procedure ProcessDeCompression(FSize:Integer);

Var

  SrcWord, SaveWord:TSingleWord;

  NewByte, BitFlag:Byte;

  OutN, TempN:Integer;

  OrdinaryWord:Boolean;

  i:Integer;

Begin

  NowBitsForDic:=ConstBitsForDic;

  OrdinaryWord:=True;

  If FSize=0 Then Exit;

  ClearWord(SrcWord);

  While ((WriteStream.BytesWrote<FSize) And Not(ReadStream.FileRead)) Do

  Begin

    BitFlag:=ReadStream.ReadBit;

    If BitFlag=0 Then  //если это просто байт

    Begin

      NewByte:=ReadStream.Read(8);

      ProcessNewByte(SrcWord, NewByte, OutN);

      WriteStream.Write(NewByte, 8);

    End

    Else Begin  //если это словарное слово

      OutN:=ReadStream.Read(NowBitsForDic);

      If OutN>=Dic.Count Then  //если нужного слова нет в словаре

      Begin

        ProcessNewByte(SrcWord, Byte(SrcWord[1]), TempN

        OrdinaryWord:=False;

      End

      Else OrdinaryWord:=True;

      SaveWord:=Dic.Words[OutN];

      SaveSingleWord(SaveWord);

      If OrdinaryWord Then  //если обычное слово, то стандартный перебор

      Begin

        For i:=1 To GetWordLength(SaveWord) Do

        Begin

          NewByte:=Byte(SaveWord[i]);

          ProcessNewByte(SrcWord, NewByte, OutN);

        End;

      End

      Else Begin  //иначе сокращенный перебор

        For i:=2 To GetWordLength(SaveWord) Do

        Begin

          NewByte:=Byte(SaveWord[i]);

          ProcessNewByte(SrcWord, NewByte, OutN);

        End;

      End;

    End;

  End;

End;

Function DeCompressFile(SrcFile, DestDir:String):Integer;

Var

  FSize:Integer;

  DestFile:String;

Begin

  Result:=0;

  Dic.Clear;

  ReadStream.OpenStream(SrcFile);

  DestFile:=DestDir+ReadFileName(FSize);

  WriteStream.OpenStream(DestFile);

  ProcessDeCompression(FSize);

  ReadStream.CloseStream;

  WriteStream.CloseStream;

End;

initialization

  Dic.Init;

  ReadStream:=TFileReadStream.Init;

  WriteStream:=TFileWriteStream.Init;

finalization

  Dic.Done;

  ReadStream.Done;

  WriteStream.Done;

end. 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 

Вывод

Все представленные здесь различные методы словарного сжатия используют одни и те же общие  принципы. Они читают файл символ за символом и добавляют фразы в  словарь. Фразы являются отдельными символами и строками символов входного файла. Методы сжатия различаются только способом отбора фраз для сохранения в словаре. Когда строка входного файла совпадает с некоторой  фразой в словаре, в сжатый файл записывается позиция этой фразы или метка. Если для хранения метки требуется  меньше бит, чем для записи самой  фразы, то наблюдается эффект сжатия.

В общем случае, словарные методы сжатия, если их применять  грамотно, дают лучшие результаты, чем  статистические методы компрессии, поэтому  они активно используются во всевозможных компрессионных приложениях, или они являются одним из этапов многостадийного сжатия. 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 

Список использованной литературы