{ Использование метода Лемпеля-Зива (LZ78) для упаковки файла:
  1) Упаковка файла с записью в архив исходного имени файла.
  2) Распаковка файла в указанный файл.
  2) Распаковка файла в файл c исходным именем.
}
{---------------------------------------------------------------------------
(c) Copyright	 Aleksandrov O.E., 1999

   Molecular Physics department, USTU, Ekaterinsburg, K-2, 620002, RUSSIA
   phone 75-47-15
   E-mail: aleks@dpt.ustu.ru

(c) Copyright Александров О.Е., 1999

   620002, Екатеринбург, К-2, УГТУ, Кафедра молекулярной физики
   тел. 75-47-15
   E-mail: aleks@dpt.ustu.ru
----------------------------------------------------------------------------}
Unit DhFile;
{$X+}

INTERFACE
  uses {$IfDef Delphi}Windows,{$EndIf}
       FileBuf, HufTypes, DHufType, DhCodec;

const
  cEOL=#$0D#$0A;

  { Идентификатор заголовка файла }
  cFileSignature='DH compressed. v1.0 '+
		 '(c) Aleksandrov O.E., 2005'+cEOL+#0;
  { Версия }
  cVersionMajor=1; {старший номер}
  cVersionMinor=0; {младший номер}

type
  { внутренние флаги }
  tFlag=(fOverwriteCompressed, fOverwriteUncompressed,
	 fOrgFileOpenedForWrite,
	 fCompressedFileIsOpened);
  tFlags=set of tFlag;

  { Версия }
  tVersion=packed record
    case byte of
      0:(Major,Minor:byte);
      1:(MajorMinor:word);
  end;

  { Размер заголовка }
  tFileHeaderSize=0..cMinBufSize;

  { Символьный массив для идентификатора заголовка файла }
  tFileSignature=packed array[0..Pred(Length(cFileSignature))] of char;

  { Заголовок файла-архива. }
  tArchiveHeader=packed record
    Signature:tFileSignature; { маркер файла-архива }
    Version:tVersion; { версия архива }
    MaxTotalCounter:longint; { ополовинивать счетчики после MaxTotalCounter символов }
  end;
  tPArchiveHeader=^tArchiveHeader;

  tFileName={$IfDef Delphi} shortstring {$else} string {$EndIf};

  { Имя исходного файла в заголовке файла-архива }
  tArcFileNameLen=1..High(byte);
  tArcFileNameData=packed array[tArcFileNameLen] of char;
  tArcFileName=packed record
    Size:tArcFileNameLen; {длина имени исходного файла}
    Text:tArcFileNameData; {имя}
  end;
  tPArcFileName=^tArcFileName;

  tFileAttribute=packed record
    case byte of
    0:(AttributeWD:word);
    1:(AttributeDW:{$IfDef Delphi}dword{$Else}longint{$EndIf});
  end;

  tFileTime=packed record
    case byte of
    0:(ShortDateTime:longint);
    1:(FullDateTime:{$IfDef Delphi}_FileTime{$Else}array [0..1] of longint{$EndIf});
  end;

  tArcFileData=packed record
    Attribute:tFileAttribute;
    DateTime:longint;
    Size:longint;     { размер исходного файла, байт}
  end;

  tArcFile=packed record
    Data:tArcFileData;
    Name:tArcFileName;
  end;

  tHeaderData=array[tFileHeaderSize] of byte;

  { Заголовок упакованного файла.}
  tFileHeader=packed record
    Size:word; { размер заголовка файла }
    Data:tArcFileData; { доп. данные о файле }
    Name:tArcFileName; { имя файла }
  end;
  tPFileHeader=^tFileHeader;

  {CYCLIC REDUNDANCY CHECKSUM - контрольная сумма.}
  tCRC=longint;

const
  cTmpCRC=$0123+($ABCD shl 16); { замена для CRC - вычисление
				контрольной суммы не реализовано }

type
  { Окончание упакованного файла.}
  tFileTail=packed record
    CRC:tCRC; { контрольная сумма файла }
  end;
  tPFileTail=^tFileTail;


  { КОДЫ ошибок сжатия }
  tError=(
    e_OK,
    e_No_Memory_For_Buffers,
    e_No_Buffers_Allocated,
    e_Cant_Open_Original_File_For_Read,
    e_Attempt_To_Rewrite_Original_File,
    e_Attempt_To_Rewrite_Compressed_File,
    e_Cant_Open_Original_File_For_Write,
    e_Cant_Open_Compressed_File_For_Write,
    e_Cant_Open_Compressed_File_For_Read,
    e_Compressed_Header_Misplaced,
    e_Cant_Write_Compressed_Buffer,
    e_Cant_Read_Compressed_Buffer,
    e_Too_Small_Buffer_To_Read_Compressed_Buffer,
    e_Too_Small_Buffer_to_Read_Compressed_File_Header,
    e_Cant_Read_Compressed_File_Header,
    e_Invalid_Compressed_File_Header,
    e_Compressed_Header_Too_Large,
    e_Cant_Read_Original_Buffer,
    e_Incorrect_Compressed_File_Version,
    e_Cant_Write_Original_Buffer,
    e_Invalid_MaxTotalCounter,
    e_Invalid_TreeRebuildCount,
    e_No_Memory_For_Dictionary,
    e_Compressed_FileTail_Too_Large,
    e_Compressed_File_Invalid_CRC,
    e_Compressed_FileTail_ErrorRead
  );

  tFileNameStr=string;

  {Объект, осуществляющий кодировку/декодировку ФАЙЛА методом Лемпеля-Зива.}
  tDHFile=object(tDHCodec)
    private
      prFlags:tFlags;
      prBuffIn,prBuffOut:tFBuffer;
      prOriginalFile,prCompressedFile:file;
      prOrgFileData:tArcFileData;
      prFileSize:{$IfDef Delphi} cardinal {$else} longint {$EndIf};
      prErr:tError;
      prOrgFileName:tFileName;
      prOrgFullFileName:string;

      prVersion:tVersion;

      procedure VersionSet(v:tVersion);

      procedure ErrorSet(e:tError);
      procedure StoreOriginalFileName(const FileName:tFileNameStr);
      function  OriginalFileName:tFileNameStr;
      procedure CloseFiles;
      procedure InitDefault;

      procedure CompressFile;
      procedure CompressBufferAndWrite;
      function  CompressBuffer:tBufferIndex;

      procedure DecompressFile;
      procedure DecompressBufferAndWrite;
      function  DecompressBuffer:tBufferIndex;

      procedure WriteArchiveHeader;
      procedure WriteCompressedFileHeader;
      procedure WriteCompressedFileTail;

      procedure ReadArchiveHeader;
      procedure ReadCompressedFileHeader;
      procedure ReadCompressedFileTail;

      function  ReadOriginalFileBuffer:tBufferIndex;
      function  ReadCompressedFileBuffer:tBufferIndex;
      procedure WriteCompressedFileBuffer;
      procedure WriteOriginalFileBuffer;

      procedure OpenCompressedFileToRead(const FileName:tFileNameStr);
      procedure OpenCompressedFileToWrite(const FileName:tFileNameStr);
      function  CloseCompressedFile:integer;

      procedure OpenOriginalFileToRead(const FileName:tFileNameStr);
      procedure OpenOriginalFileToWrite(const FileName:tFileNameStr);
      function  CloseOriginalFile:integer;

      function  CheckBuffers:boolean;

    public
      constructor Init(aBufferSize:tByteBufferIndex);
      destructor Done; virtual;

      function  LastError:tError;
      function  ErrorMsg(aErrorCode:tError):string;
      function  LastErrorMsg:string;
      function  Error:boolean;
      function  NoError:boolean;
      function  BufferSize:tBufferIndex;

      function  Flag(f:tFlag):boolean;
      procedure FlagSet(f:tFlag);
      procedure FlagClear(f:tFlag);
      function  Version:word;
      function  VersionMajor:byte;
      function  VersionMinor:byte;

      procedure EncodeFile(const FileName:tFileNameStr;
			   const PackedFileName:tFileNameStr);
      procedure DecodeFile(const PackedFileName:tFileNameStr;
			   const FileName:tFileNameStr);
      procedure DecodeFileToOriginal(const PackedFileName:tFileNameStr;
				     const DirName:tFileNameStr;
				     var   FileName:tFileNameStr);
  end;

IMPLEMENTATION
  USES
    xStrings, {$IfNDef Delphi}Dos, Strings,{$Else}sysutils,{$EndIf}
    uMiscFun;

const
  cHeader:tArchiveHeader=(
      Signature:cFileSignature;
      Version:(Major:cVersionMajor; Minor:cVersionMinor);
      MaxTotalCounter:0
  );

function  tDHFile.ErrorMsg(aErrorCode:tError):string;
begin
  case aErrorCode of
    e_OK:
      ErrorMsg:='═хЄ ю°шсъш';
    e_No_Memory_For_Buffers:
      ErrorMsg:='═х їтрЄрхЄ ярь Єш фы  сєЇхЁют ўЄхэш /чряшёш Їрщыр';
    e_No_Buffers_Allocated:
      ErrorMsg:='═х Ёрчьх∙хэ√ сєЇхЁр ўЄхэш /чряшёш Їрщыр';
    e_Cant_Open_Original_File_For_Read:
      ErrorMsg:='═х ьюує юЄъЁ√Є№ шёїюфэ√щ Їрщы фы  ўЄхэш ';
    e_Attempt_To_Rewrite_Original_File:
      ErrorMsg:='╧юя√Єър яхЁхчряшёрЄ№ шёїюфэ√щ Їрщы';
    e_Attempt_To_Rewrite_Compressed_File:
      ErrorMsg:='╧юя√Єър яхЁхчряшёрЄ№ єяръютрээ√щ Їрщы';
    e_Cant_Open_Original_File_For_Write:
      ErrorMsg:='═х ьюує юЄъЁ√Є№ шёїюфэ√щ Їрщы фы  чряшёш';
    e_Cant_Open_Compressed_File_For_Write:
      ErrorMsg:='═х ьюує юЄъЁ√Є№ єяръютрээ√щ Їрщы фы  чряшёш';
    e_Cant_Open_Compressed_File_For_Read:
      ErrorMsg:='═х ьюує юЄъЁ√Є№ єяръютрээ√щ Їрщы фы  ўЄхэш ';
    e_Compressed_Header_Misplaced:
      ErrorMsg:='═хЄ чруюыютър т єяръютрээюь Їрщых шыш ¤Єю эх єяръютрээ√щ Їрщы';
    e_Cant_Write_Compressed_Buffer:
      ErrorMsg:='═х ьюує чряшёрЄ№ фрээ√х т єяръютрээ√щ Їрщы';
    e_Cant_Read_Compressed_Buffer:
      ErrorMsg:='═х ьюує ёўшЄрЄ№ фрээ√х шч єяръютрээюую Їрщыр';
    e_Too_Small_Buffer_To_Read_Compressed_Buffer:
      ErrorMsg:='╤ыш°ъюь ьрыхэ№ъшщ сєЇхЁ фы  фрээ√ї шч єяръютрээюую Їрщыр';
    e_Too_Small_Buffer_to_Read_Compressed_File_Header:
      ErrorMsg:='╤ыш°ъюь ьрыхэ№ъшщ сєЇхЁ фы  чруюыютър єяръютрээюую Їрщыр';
    e_Cant_Read_Compressed_File_Header:
      ErrorMsg:='═х ьюує ёўшЄрЄ№ чруюыютюъ єяръютрээюую Їрщыр';
    e_Invalid_Compressed_File_Header:
      ErrorMsg:='═хяЁртшы№э√щ чруюыютюъ єяръютрээюую Їрщыр';
    e_Compressed_Header_Too_Large:
      ErrorMsg:='╤ыш°ъюь сюы№°ющ чруюыютюъ єяръютрээюую Їрщыр';
    e_Cant_Read_Original_Buffer:
      ErrorMsg:='═х ьюує ёўшЄрЄ№ фрээ√х шч шёїюфэюую Їрщыр';
    e_Incorrect_Compressed_File_Version:
      ErrorMsg:='═хяюффхЁцштрхьр  тхЁёш  єяръютрээюую Їрщыр';
    e_Cant_Write_Original_Buffer:
      ErrorMsg:='═х ьюує чряшёрЄ№ фрээ√х т шёїюфэ√щ Їрщы';
    e_Invalid_MaxTotalCounter:
      ErrorMsg:='═хфюяєёЄшь√щ ЁрчьхЁ ьръёшьры№эюую ЇЁруьхэЄр';
    e_Invalid_TreeRebuildCount:
      ErrorMsg:='═хфюяєёЄшь√щ ЁрчьхЁ ёыютрЁ ';
    e_No_Memory_For_Dictionary:
      ErrorMsg:='═хфюёЄрЄюўэю ярь Єш фы  Ёрчьх∙хэш  ёыютрЁ ';
    e_Compressed_FileTail_Too_Large:
      ErrorMsg:='╤ыш°ъюь сюы№°ющ ёєЇЇшъё єяръютрээюую Їрщыр';
    e_Compressed_File_Invalid_CRC:
      ErrorMsg:='═хтхЁэр  ъюэЄЁюы№эр  ёєььр';
    e_Compressed_FileTail_ErrorRead:
      ErrorMsg:='═х ьюує ёўшЄрЄ№ ёєЇЇшъё єяръютрээюую Їрщыр';
    else
      ErrorMsg:='═хшчтхёЄэр  ю°шсър';
  end;
end;

procedure tDHFile.ErrorSet(e:tError);
begin
  if e=e_OK then
    prErr:=e
  else if prErr=e_OK then
    prErr:=e;
end;

function tDHFile.LastError:tError;
begin
  LastError:=prErr;
end;

function  tDHFile.Error:boolean;
begin
  Error:=(prErr<>e_OK);
end;

function  tDHFile.NoError:boolean;
begin
  NoError:=(prErr=e_OK);
end;

function  tDHFile.BufferSize:tBufferIndex;
begin
  BufferSize:=prBuffIn.Size;
end;

destructor tDHFile.Done;
begin
  Inherited Done;
  CloseFiles;
  prBuffIn.Deallocate;
  prBuffOut.Deallocate;
end;

constructor tDHFile.Init;
begin
  prBuffIn.Allocate((aBufferSize div SizeOf(tByte))*SizeOf(tByte));
  prBuffIn.EmptySizeSet(SizeOf(tByte)-1);
  prBuffOut.Allocate(aBufferSize);
  prFlags:=[];
  prOrgFileData.Attribute.AttributeDW:=0;
  prOrgFileData.DateTime:=0;
  prOrgFileData.Size:=0;
  VersionSet(cHeader.Version);
  if (prBuffOut.Size=0) or (prBuffIn.Size=0) then begin
    Done;
    ErrorSet(e_No_Memory_For_Buffers);
    Fail;
  end else begin
    ErrorSet(e_OK);
  end;
  Inherited Init;
end;

procedure tDHFile.InitDefault;
begin
  if (BufferSize=0) then begin
    Init(cDefaultBufSize);
  end;
end;

procedure tDHFile.StoreOriginalFileName;
{$IfNDef Delphi}
var
 Path: PathStr;
 Dir:  DirStr;
 Name: NameStr;
 Ext:  ExtStr;
begin
  FSplit(FileName, Dir, Name, Ext);
  prOrgFileName:=Name+Ext;
end;
{$Else}
begin
  prOrgFileName:=ExtractFileName(FileName);
end;
{$EndIf}

function tDHFile.OriginalFileName:tFileNameStr;
begin
  OriginalFileName:=prOrgFileName;
end;

{$IfOpt I+} {$Define IisON} {$I-} {$EndIf}
function GetFileTimeAndAttributes(const FileName:string; var FileData:tArcFileData):integer;
{$IfDef Delphi}
begin
  Result:=0;
  FileData.DateTime:=FileAge(FileName);
  if  FileData.DateTime=-1 then begin
    FileData.DateTime:=0;
  end else begin
    Result:=Result or 1;
  end;
  FileData.Attribute.AttributeDW:=GetFileAttributes(PChar(FileName));
  if  FileData.Attribute.AttributeDW=DWord(-1) then begin
    FileData.Attribute.AttributeDW:=0;
  end else begin
    Result:=Result or 3;
  end;
end;
{$Else}
  var F:File; Result:integer;
begin
  Result:=0;
  Assign(F,FileName);
  GetFAttr(F,FileData.Attribute.AttributeWD);
  if IoResult=0 then
    Result:=Result or 1;
  GetFTime(F,FileData.DateTime);
  if IoResult=0 then
    Result:=Result or 3;
  GetFileTimeAndAttributes:=Result;
end;
{$EndIf}

procedure tDHFile.OpenOriginalFileToRead;
  var OldFileMode:byte;
begin
  ErrorSet(e_OK);
  Assign(prOriginalFile,FileName);
  GetFileTimeAndAttributes(FileName,prOrgFileData);

  OldFileMode:=System.FileMode;
  System.FileMode:={$IfDef Delphi}fmOpenRead+fmShareDenyWrite{$Else}0{$EndIf};
  Reset(prOriginalFile,SizeOf(byte));
  System.FileMode:=OldFileMode;
  if IOResult<>0 then begin
    ErrorSet(e_Cant_Open_Original_File_For_Read);
  end else begin
    prOrgFileData.Size:=FileSize(prOriginalFile);
  end;
  FlagClear(fOrgFileOpenedForWrite);
{  Exclude(prFlags,fOrgFileOpenedForWrite);}
end;

procedure tDHFile.OpenCompressedFileToWrite;
begin
  ErrorSet(e_OK);
  Assign(prCompressedFile,FileName);
  if (not (Flag(fOverwriteCompressed))) and FileExists(FileName) then begin
    ErrorSet(e_Attempt_To_Rewrite_Compressed_File);
    Exit;
  end;
  Rewrite(prCompressedFile,SizeOf(byte));
  if IOResult<>0 then begin
    ErrorSet(e_Cant_Open_Compressed_File_For_Write);
  end else begin
    FlagSet(fCompressedFileIsOpened);
{    Include(prFlags,fCompressedFileIsOpened);}
    WriteArchiveHeader;
  end;
end;

procedure tDHFile.OpenOriginalFileToWrite;
begin
  ErrorSet(e_OK);
 {$IfDef Delphi}
   prOrgFullFileName:=ExpandUNCFileName(FileName);
   Assign(prOriginalFile,prOrgFullFileName);
 {$Else}
   prOrgFullFileName:=FileName;
   Assign(prOriginalFile,FileName);
 {$EndIf}
  if (not (Flag(fOverwriteUncompressed))) and FileExists(FileName) then begin
    ErrorSet(e_Attempt_To_Rewrite_Original_File);
    Exit;
  end;
  Rewrite(prOriginalFile,SizeOf(byte));
  if IOResult<>0 then begin
    ErrorSet(e_Cant_Open_Original_File_For_Write);
  end else begin
    FlagSet(fOrgFileOpenedForWrite);
{    Include(prFlags,fOrgFileOpenedForWrite);}
  end;
end;

procedure tDHFile.OpenCompressedFileToRead;
  var OldFileMode:byte;
begin
  ErrorSet(e_OK);
  Assign(prCompressedFile,FileName);
  OldFileMode:=System.FileMode;
  System.FileMode:={$IfDef Delphi}fmOpenRead+fmShareDenyWrite{$Else}0{$EndIf};
  Reset(prCompressedFile,SizeOf(byte));
  System.FileMode:=OldFileMode;
  if IOResult<>0 then begin
    ErrorSet(e_Cant_Open_Compressed_File_For_Read);
  end else begin
    FlagSet(fCompressedFileIsOpened);
{    Include(prFlags,fCompressedFileIsOpened);}
    ReadArchiveHeader;
    if Error then begin
      CloseCompressedFile;
    end;
  end;
end;

function SizeOfFileName(const FileName:tFileName):word;
begin
  SizeOfFileName:=Length(FileName);
end;

function SetFileTimeAndAttributes(const FileName:string; var FileData:tArcFileData):integer;
{$IfDef Delphi}
  var h:tHandle;
begin
  Result:=0;
  if SetFileAttributes(PChar(FileName),FileData.Attribute.AttributeDW) then begin
    Inc(Result);
  end;
  h:=CreateFile(PChar(FileName),GENERIC_WRITE,FILE_SHARE_READ,NIL,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0);
  if h<>INVALID_HANDLE_VALUE then begin
    if FileSetDate(h, FileData.DateTime)=0 then begin
      Result:=Result or 3;
    end;
    CloseHandle(h);
  end;
end;
{$Else IfDef Delphi}
  var Result:integer; F:File;
begin
  Assign(F,FileName);
  Result:=0;
  SetFAttr(F,FileData.Attribute.AttributeWD);
  if IOResult=0 then begin
    Result:=Result or 1;
  end;
  SetFTime(F,FileData.DateTime);
  if IOResult=0 then begin
    Result:=Result or 3;
  end;
end;
{$EndIf Def Delphi}

function tDHFile.CloseOriginalFile;
  var ior:integer;
begin
  Close(prOriginalFile);
  ior:=IOResult;
  if (ior=0) and Flag(fOrgFileOpenedForWrite) then begin
{  if (ior=0) and (fOrgFileOpenedForWrite in prFlags) then begin}
    SetFileTimeAndAttributes(prOrgFullFileName,prOrgFileData);
  end;
  FlagClear(fOrgFileOpenedForWrite);
{  Exclude(prFlags,fOrgFileOpenedForWrite);}
  CloseOriginalFile:=ior;
end;

function  tDHFile.CloseCompressedFile;
begin
  Close(prCompressedFile);
  CloseCompressedFile:=IOResult;
  FlagClear(fCompressedFileIsOpened);
{  Exclude(prFlags,fCompressedFileIsOpened);}
end;
{$IfDef IisON} {$UnDef IisON} {$I+} {$EndIf}

{ Запись заголовка архива }
procedure tDHFile.WriteArchiveHeader;
  var
    PHeader:tPArchiveHeader;
begin
  PHeader:=tPArchiveHeader(prBuffOut.PBuffChecked);
  PHeader^:=cHeader;
  PHeader^.MaxTotalCounter:=EffectiveMaxTotalCounter;
  VersionSet(PHeader^.Version);
  prBuffOut.DataSizeSet(SizeOf(PHeader^));

  if NoError
    and (FilePos(prCompressedFile)=0) then begin
    WriteCompressedFileBuffer;
  end else begin
    ErrorSet(e_Compressed_Header_Misplaced);
  end;
end;

{ Запись заголовка файла в архиве }
procedure tDHFile.WriteCompressedFileHeader;
  var
    PHeader:tPFileHeader;
    sz:word;
begin
  PHeader:=tPFileHeader(prBuffOut.PBuffChecked);

  sz:=SizeOf(PHeader^)-SizeOf(PHeader^.Name)+Succ(Length(prOrgFileName));
  if sz<=prBuffOut.FreeSize then begin
    PHeader^.Data:=prOrgFileData;
    PHeader^.Name.Size:=Length(prOrgFileName);
    Move(prOrgFileName[1], PHeader^.Name.Text, PHeader^.Name.Size);
    PHeader^.Size:=sz-SizeOf(PHeader^.Size);
    prBuffOut.DataSizeSet(sz);
  end else begin
    ErrorSet(e_Compressed_Header_Too_Large);
  end;

  if NoError then begin
    WriteCompressedFileBuffer;
  end;
end;

procedure tDHFile.ReadArchiveHeader;
  var PHeader:tPArchiveHeader;
begin
  PHeader:=tPArchiveHeader(prBuffIn.PBuffChecked);
  if NoError and (FilePos(prCompressedFile)=0) then begin
    prBuffIn.Clear;
    prBuffIn.ReadSize(prCompressedFile, SizeOf(PHeader^));
    if prBuffIn.NoError then begin
      {$IfNDef Delphi}
      if PHeader^.Signature=cFileSignature then begin
      {$Else}
      if Equal(PHeader^.Signature,cFileSignature,SizeOf(PHeader^.Signature)) then begin
      {$EndIf}
	VersionSet(PHeader^.Version);
	if Version=cHeader.Version.MajorMinor then begin
	  if (PHeader^.MaxTotalCounter<>EffectiveMaxTotalCounter) then begin
	    ErrorSet(e_Invalid_MaxTotalCounter);
	  end;
	end else begin
	  ErrorSet(e_Incorrect_Compressed_File_Version);
	end;
      end else begin
	ErrorSet(e_Invalid_Compressed_File_Header);
      end;
    end else begin
      ErrorSet(e_Cant_Read_Compressed_File_Header);
    end;
  end else begin
    ErrorSet(e_Compressed_Header_Misplaced);
  end;
end;

procedure tDHFile.ReadCompressedFileHeader;
  var
    PHeader:tPFileHeader;
    sz:word; (*{$IfNDef Delphi}word{$Else}integer{$EndIf};*)
begin
  if NoError then begin
    prBuffIn.Clear;
    prBuffIn.ReadSize(prCompressedFile, SizeOf(PHeader^.Size));
    if prBuffIn.NoError then begin
      PHeader:=tPFileHeader(prBuffIn.PBuff);
      if (PHeader^.Size<=prBuffIn.FreeSize) then begin
	prBuffIn.ReadSize(prCompressedFile, PHeader^.Size);
	if prBuffIn.NoError then begin
	  sz:=SizeOf(PHeader^)-SizeOf(PHeader^.Name)-1+PHeader^.Name.Size;
	  if (sz<=PHeader^.Size)
	     {and (PHeader^.Name.Size<=High(tArcFileNameLen))} then begin
	    Move(PHeader^.Name,prOrgFileName,Succ(PHeader^.Name.Size));
	    prOrgFileData:=PHeader^.Data;
	    prFileSize:=prOrgFileData.Size;
	  end else begin
	    ErrorSet(e_Invalid_Compressed_File_Header);
	  end;
	end else begin
	  ErrorSet(e_Cant_Read_Compressed_File_Header);
	end;
      end else begin
	ErrorSet(e_Too_Small_Buffer_to_Read_Compressed_File_Header);
      end;
    end else begin
      ErrorSet(e_Cant_Read_Compressed_File_Header);
    end;
  end;
end;

{var wbC:cardinal;}
procedure tDHFile.WriteCompressedFileBuffer;
begin
  prBuffOut.Write(prCompressedFile);
{  Inc(wbC,prBuffOut.DataSize);
  write(wbC,' ');}
  if prBuffOut.Error then begin
    ErrorSet(e_Cant_Write_Compressed_Buffer);
  end;
end;

function tDHFile.ReadOriginalFileBuffer;
begin
  prBuffIn.Read(prOriginalFile);
  if prBuffIn.Error then begin
    ErrorSet(e_Cant_Read_Original_Buffer);
  end;
  if (prBuffIn.DataSize<=prBuffIn.EmptySize) AND (prBuffIn.DataSize>0) then
    ReadOriginalFileBuffer:=prBuffIn.EmptySize+1
  else
    ReadOriginalFileBuffer:=prBuffIn.DataSize;
end;

{var rbC:cardinal;}
function tDHFile.ReadCompressedFileBuffer;
begin
  ReadCompressedFileBuffer:=0;
  if Error then Exit;
  if not Eof(prCompressedFile) then begin
    prBuffIn.Read(prCompressedFile);
    if prBuffIn.Error then begin
      ErrorSet(e_Cant_Read_Compressed_Buffer);
    end;
  end;
  ReadCompressedFileBuffer:=prBuffIn.DataSize;
{  Inc(rbC,prBuffIn.DataSize);
  write(rbC,' ');}
end;

procedure tDHFile.WriteCompressedFileTail;
  var
    PTail:tPFileTail;
    sz:{$IfNDef Delphi}word{$Else}integer{$EndIf};
begin
{  writeln('Tail ', wbC,' ');}
  PTail:=tPFileTail(prBuffOut.PBuffChecked);
  sz:=SizeOf(PTail^);
  if sz<=prBuffOut.Size then begin
    PTail^.CRC:=cTmpCRC;
    prBuffOut.DataSizeSet(sz);
  end else begin
    ErrorSet(e_Compressed_FileTail_Too_Large);
  end;

  if NoError then begin
    WriteCompressedFileBuffer;
  end;
end;

procedure tDHFile.ReadCompressedFileTail;
  var
    PTail:tPFileTail;
    sz:word; (*{$IfNDef Delphi}word{$Else}integer{$EndIf};*)
begin
{  writeln('Tail ', rbC,' ');}
  PTail:=tPFileTail(prBuffIn.PBuffChecked);
  sz:=SizeOf(PTail^);
  if prBuffIn.DataSize<sz then begin
    Dec(sz,prBuffIn.DataSize);
    if sz<=prBuffIn.FreeSize then begin
      if prBuffIn.ReadSize(prCompressedFile, sz)<>sz then
	ErrorSet(e_Compressed_FileTail_ErrorRead);
    end else begin
      ErrorSet(e_Compressed_FileTail_Too_Large);
    end;
  end;
  if PTail^.CRC<>cTmpCRC then
    ErrorSet(e_Compressed_File_Invalid_CRC);
end;

procedure tDHFile.WriteOriginalFileBuffer;
begin
  prBuffOut.Write(prOriginalFile);
  if prBuffOut.Error then begin
    ErrorSet(e_Cant_Write_Original_Buffer);
  end;
end;

function tDHFile.CompressBuffer;
  var EncodedSize:tBufferIndex;
      EncodedDataSize:tByteBufferIndex;
begin
  { кодирование }
  Encode(prBuffIn.PBuffChecked^, prBuffIn.DataSize, EncodedSize,
		 prBuffOut.PBuffChecked^,prBuffOut.Size,   EncodedDataSize);
  { изменение размера данных в буферах }
  prBuffIn.DataShiftToBegin(EncodedSize); { удаляем закодированную часть из BuffIn}
  prBuffOut.DataSizeSet(EncodedDataSize); { устанавливаем размер данных в кодированном BuffOut}
  { возвращаем размер данных в кодированном буфере }
  CompressBuffer:=EncodedDataSize;
end;

function tDHFile.DecompressBuffer;
  var
    DecodedSize:tByteBufferIndex;
    OutSize,DecodedDataSize:tBufferIndex;
begin
  { Вычисляем оставшийся для декомпрессии размер файла }
  OutSize:=prBuffOut.Size;
  if OutSize>prFileSize then begin
{    OutSize:=prFileSize;}
    OutSize:=(((prFileSize + Pred(SizeOf(tByte))) div SizeOf(tByte))*SizeOf(tByte) );
  end;
  Decode(
     prBuffIn.PBuffChecked^,  prBuffIn.DataSize, DecodedSize,
     prBuffOut.PBuffChecked^, OutSize,           DecodedDataSize
  );
  { изменение размера данных в буферах }
  if DecodedDataSize>prFileSize then begin
    DecodedDataSize:=prFileSize;
  end;
  Dec(prFileSize,DecodedDataSize);
  prBuffIn.DataShiftToBegin(DecodedSize);
  prBuffOut.DataSizeSet(DecodedDataSize);
  DecompressBuffer:=DecodedDataSize;
end;

procedure tDHFile.CompressBufferAndWrite;
begin
  repeat
    CompressBuffer;
    WriteCompressedFileBuffer;
  until prBuffIn.Empty;
end;

procedure tDHFile.DecompressBufferAndWrite;
begin
  repeat
    DecompressBuffer;
    WriteOriginalFileBuffer;
  until prBuffIn.Empty or (prFileSize=0);
end;

procedure tDHFile.CompressFile;
begin
  EncodeReset;
  while NoError and (ReadOriginalFileBuffer>0) do begin
    CompressBufferAndWrite;
  end;
  if NoError then begin
    CompressBufferAndWrite; { заносим в файл остатки бит }
  end;
end;

procedure tDHFile.DecompressFile;
begin
  DecodeReset;
  prBuffIn.Clear;
  while (ReadCompressedFileBuffer>0) and (prFileSize>0) do begin
    DecompressBufferAndWrite;
  end;
end;

procedure tDHFile.CloseFiles;
begin
  CloseOriginalFile;
  CloseCompressedFile;
end;

procedure tDHFile.EncodeFile;
begin
  InitDefault;
  if CheckBuffers then begin
    ErrorSet(e_OK);
    OpenOriginalFileToRead(FileName);
    if Error then Exit;
    OpenCompressedFileToWrite(PackedFileName);
    if NoError then begin
      StoreOriginalFileName(FileName);
      WriteCompressedFileHeader; { записываем заголовок сжатого файла }
      if NoError then
	CompressFile;
     if NoError then
	WriteCompressedFileTail; { записываем хвост сжатого файла }
    end;
    CloseFiles;
  end;
end;

procedure tDHFile.DecodeFile;
begin
  InitDefault;
  if CheckBuffers then begin
    ErrorSet(e_OK);
    OpenOriginalFileToWrite(FileName);
    if Error then Exit;
    OpenCompressedFileToRead(PackedFileName);
    if NoError then begin
      ReadCompressedFileHeader;
      if NoError then
	DecompressFile;
      if NoError then
	ReadCompressedFileTail;
    end;
    CloseFiles;
  end;
end;

function GetDir(const FileName:tFileNameStr):tFileNameStr;
{$IfNDef Delphi}
var
 Path: PathStr;
 Dir:  DirStr;
 Name: NameStr;
 Ext:  ExtStr;
begin
  FSplit(FileName, Dir, Name, Ext);
  if Dir[Length(Dir)]<>'\' then GetDir:=Dir+'\' else GetDir:=Dir;
end;
{$Else}
begin
  Result:=IncludeTrailingBackslash(ExtractFilePath(FileName));
end;
{$EndIf}

procedure tDHFile.DecodeFileToOriginal;
begin
  InitDefault;
  if CheckBuffers then begin
    ErrorSet(e_OK);
    OpenCompressedFileToRead(FileName);
    if Error then Exit;
    OpenOriginalFileToWrite(GetDir(FileName)+OriginalFileName);
    if NoError then begin
      ReadCompressedFileHeader;
      if NoError then
	DecompressFile;
      if NoError then
	ReadCompressedFileTail;
    end;
    CloseFiles;
  end;
end;

function  tDHFile.CheckBuffers:boolean;
begin
  if (BufferSize=0) then begin
    CheckBuffers:=FALSE;
    ErrorSet(e_No_Buffers_Allocated);
  end else begin
    CheckBuffers:=TRUE;
  end;
end;

function  tDHFile.Flag(f:tFlag):boolean;
begin
  Flag:=f in prFlags;
end;

procedure tDHFile.FlagSet(f:tFlag);
begin
  Include(prFlags,f);
end;

procedure tDHFile.FlagClear(f:tFlag);
begin
  Exclude(prFlags,f);
end;

procedure tDHFile.VersionSet;
begin
  prVersion:=v;
end;

function  tDHFile.Version:word;
begin
  Version:=prVersion.MajorMinor;
end;

function  tDHFile.VersionMajor:byte;
begin
  VersionMajor:=prVersion.Major;
end;

function  tDHFile.VersionMinor:byte;
begin
  VersionMinor:=prVersion.Minor;
end;

function  tDHFile.LastErrorMsg:string;
begin
  LastErrorMsg:=ErrorMsg(LastError);
end;

END.