{ Использование метода Хаффмана для упаковки файла:
  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 HuffmanF;
{$X+}

INTERFACE
  uses {$IfDef Delphi}Windows,{$EndIf}HufTypes, HuffmanE;

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

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

  cMinBufSize=1000; { минимальный размер буфера для файла }
  cDefaultBufSize=64000;  { размер буфера для файла ПО-УМОЛЧАНИЮ }

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

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

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

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

  { БАЗОВЫЙ Заголовок упакованного файла.}
  tCompressedFileHeader0=record
    Signature:tFileSignature; {маркер файла-архива}
    Size:tFileHeaderSize; {полный размер заголовка }
    Version:tVersion;
  end;

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

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

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

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

  tArcFileData=record
    Attribute:tFileAttribute;
    DateTime:longint;
  end;

  tArcFile=record
    Data:tArcFileData;
    Name:tArcFileName;
  end;
  tPArcFile=^tArcFile;

  tHeaderData=array[tFileHeaderSize] of byte;
  { Заголовок упакованного файла.}
  tCompressedFileHeader=record
    Header0:tCompressedFileHeader0;
    Data:tHeaderData;
  end;
  tPCompressedFileHeader=^tCompressedFileHeader;

  { Флаги упакованного блока }
  tCompressedFileBlockFlag=(fCompressed{, fHeader16, fHeader32});
  tCompressedFileBlockFlags=set of tCompressedFileBlockFlag;

  {CYCLIC REDUNDANCY CHECKSUM - контрольная сумма.}
  tCRC={$IfDef Delphi}cardinal{$else}longint{$EndIf};

  { БАЗОВЫЙ Заголовок упакованного блока файла }
  tFileBlockHeader=packed record
    Flags:tCompressedFileBlockFlags; { флаги блока }
    CRC:tCRC; { Контрольная сумма. Здесь не используется, но нужна для
	      проверки целостности данных.}
  end;

  { ПОЛНЫЙ Заголовок упакованного блока файла }
  tCompressedFileBlockHeader=record
    Header0:tFileBlockHeader;
    Size:tBufferSize; { размер блока без заголовка }
  end;
  tPCompressedFileBlockHeader=^tCompressedFileBlockHeader;

  { Упакованный блок файла }
  tCompressedFileBlock=record
    Header:tCompressedFileBlockHeader;
    Data:tBuffer;
  end;
  tPCompressedFileBlock=^tCompressedFileBlock;


  { Ошибки сжатия }
  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
  );

  tFileNameStr=string;

  { Ошибки буфера }
  tBufError=(ebOK, ebAllocateFail, ebReadFail, ebWriteFail, ebTooSmallFreeSize);

  { Буфер для чтения-записи файла }
  tFBuffer=object
    private
      prLastError:tBufError;
      prBufSize,prNotBufSize:tBufferIndex;
      prBuff:tPBuffer;
      prDataSize:tBufferIndex;
      function  SetLastError(ErrCode:tBufError):tBufError;
    public
      procedure Allocate(SizeToAllocate:tBufferIndex);
      procedure DeAllocate;
      function  LastError:tBufError;
      function  NoError:boolean;
      function  Error:boolean;
      function  PBuff:tPBuffer;
      function  PBuffChecked:tPBuffer;
      function  PCompressedBlockData:tPBuffer;
      function  PCompressedBlockHeader:tPCompressedFileBlockHeader;
      function  Size:tBufferIndex;
      function  DataSize:tBufferIndex;
      function  FreeSize:tBufferIndex;
      procedure DataSizeSet(sz:tBufferIndex);
      procedure DataSizeInc(sz:tBufferIndex);
      procedure DataShiftToBegin(sz:tBufferIndex);
      function  Write(var fl:File):tBufferIndex;
      function  ReadEx(var fl:File; SizeToRead:tBufferIndex):tBufferIndex;
      function  Read(var fl:File):tBufferIndex;
      function  ReadWithReserve(var fl:File; ReservedSize:tBufferIndex):tBufferIndex;
      function  ReadSize(var fl:File; SizeToRead:tBufferIndex):tBufferIndex;
  end;

  {Объект, осуществляющий кодировку/декодировку ФАЙЛА методом Хаффмана.}
  tHuffman=object(HuffmanE.tHuffman)
    private
      prFlags:tFlags;
      prBuffIn,prBuffOut:tFBuffer;
      prOriginalFile,prCompressedFile:file;
      prOrgFullFileName:string;
      prOrgFileData:tArcFileData;
      prErr:tError;
      prOrgFileName:tFileName;

      prVersion:tVersion;

      procedure VersionSet(v:tVersion);
      procedure VersionMajorSet(v:byte);
      procedure VersionMinorSet(v:byte);

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

      procedure CompressFile;
      procedure CompressFileOptimal;
      procedure CompressBufferAndWrite;
      procedure CompressBufferAndWriteOptimal;
      function  CompressBuffer:tBufferIndex;
      function  CompressBufferOptimal:tBufferIndex;

      procedure DecompressFile;
      procedure DecompressBufferAndWrite;
      function  DecompressBuffer:tBufferIndex;

      procedure WriteCompressedFileHeader;
      procedure ReadCompressedFileHeader;

      function  ReadOriginalFileBuffer:tBufferIndex;
      function  ReadCompressedFileBuffer:tBufferIndex;
{      function  ReadBufferFromCompressedFile: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(BufSize:tBufferIndex);
      destructor Done;
      function  LastError:tError;
      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 EncodeFileOptimal(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:tCompressedFileHeader0=(
      Signature:cFileSignature;
      Size:0;
      Version:(Major:cVersionMajor; Minor:cVersionMinor)
  );

procedure tHuffman.ErrorSet(e:tError);
begin
  prErr:=e;
end;

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

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

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

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

destructor tHuffman.Done;
begin
  Stop;
  prBuffIn.Deallocate;
  prBuffOut.Deallocate;
end;

constructor tHuffman.Init;
begin
  inherited Init;
  prBuffIn.Allocate(BufSize);
  prBuffOut.Allocate(BufSize);
  prFlags:=[];
  prOrgFileData.Attribute.AttributeDW:=0;
  prOrgFileData.DateTime:=0;
  VersionSet(cHeader.Version);
  if (prBuffOut.Size=0) or (prBuffIn.Size=0) then begin
    Done;
    ErrorSet(e_No_Memory_For_Buffers);
  end else begin
    ErrorSet(e_OK);
  end;
end;

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

procedure tHuffman.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 tHuffman.OriginalFileName:tFileNameStr;
begin
  OriginalFileName:=prOrgFileName;
end;

{$IfOpt I+} {$Define IisON} {$I-} {$EndIf}

function GetFileTimeAndAttributes(const FileName:string; var FileData:tArcFileData):integer;
{$IfDef Delphi}
{  var h:tHandle;}
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 If Def Delphi}
  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 Def Delphi}

procedure tHuffman.OpenOriginalFileToRead;
  var OldFileMode:byte;
begin
  ErrorSet(e_OK);
  Assign(prOriginalFile,FileName);
  GetFileTimeAndAttributes(FileName,prOrgFileData);
  OldFileMode:=System.FileMode;
  System.FileMode:=0;
  Reset(prOriginalFile,SizeOf(tByte));
  System.FileMode:=OldFileMode;
  if IOResult<>0 then begin
    ErrorSet(e_Cant_Open_Original_File_For_Read);
  end;
  Exclude(prFlags,fOrgFileOpenedForWrite);
end;

procedure tHuffman.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(tByte));
  if IOResult<>0 then begin
    ErrorSet(e_Cant_Open_Compressed_File_For_Write);
  end;
end;

procedure tHuffman.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(tByte));
  if IOResult<>0 then begin
    ErrorSet(e_Cant_Open_Original_File_For_Write);
  end else begin
    Include(prFlags,fOrgFileOpenedForWrite);
  end;
end;

procedure tHuffman.OpenCompressedFileToRead;
  var OldFileMode:byte;
begin
  ErrorSet(e_OK);
  Assign(prCompressedFile,FileName);
  OldFileMode:=System.FileMode;
  System.FileMode:=0;
  Reset(prCompressedFile,SizeOf(tByte));
  System.FileMode:=OldFileMode;
  if IOResult<>0 then begin
    ErrorSet(e_Cant_Open_Compressed_File_For_Read);
  end else begin
    ReadCompressedFileHeader;
    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 tHuffman.CloseOriginalFile;
  var ior:integer;
begin
  Close(prOriginalFile);
  ior:=IOResult;
  if (ior=0) and (fOrgFileOpenedForWrite in prFlags) then begin
    SetFileTimeAndAttributes(prOrgFullFileName,prOrgFileData);
  end;
  Exclude(prFlags,fOrgFileOpenedForWrite);
  CloseOriginalFile:=ior;
end;

function  tHuffman.CloseCompressedFile;
begin
  Close(prCompressedFile);
  CloseCompressedFile:=IOResult;
end;
{$IfDef IisON} {$UnDef IisON} {$I+} {$EndIf}

procedure tHuffman.WriteCompressedFileHeader;
  var
    PHeader:tPCompressedFileHeader;
    sz:{$IfNDef Delphi}word{$Else}integer{$EndIf};
    PArcFile:tPArcFile;
begin
  PHeader:=tPCompressedFileHeader(prBuffOut.PBuffChecked);
  PHeader^.Header0:=cHeader;
  VersionSet(PHeader^.Header0.Version);
  prBuffOut.DataSizeSet(SizeOf(PHeader^.Header0));

  sz:=Succ(Length(prOrgFileName))+SizeOf(tArcFileData);
  if sz<=prBuffOut.FreeSize then begin
    PArcFile:=tPArcFile(@PHeader^.Data[PHeader^.Header0.Size]);
    PArcFile^.Data:=prOrgFileData;
    Move(prOrgFileName, PArcFile^.Name, Succ(Length(prOrgFileName)));
    Inc(PHeader^.Header0.Size,sz);
    prBuffOut.DataSizeInc(sz);
  end else begin
    ErrorSet(e_Compressed_Header_Too_Large);
  end;

  if NoError
    and (PHeader^.Header0.Size>0)
    and (FilePos(prCompressedFile)=0) then begin
    WriteCompressedFileBuffer;
  end else begin
    ErrorSet(e_Compressed_Header_Misplaced);
  end;
end;

procedure tHuffman.ReadCompressedFileHeader;
  var
    PHeader:tPCompressedFileHeader;
    sz:{$IfNDef Delphi}word{$Else}integer{$EndIf};
    PArcFile:tPArcFile;
begin
  PHeader:=tPCompressedFileHeader(prBuffIn.PBuff);
  prBuffIn.DataSizeSet(0);
  prBuffIn.ReadSize(prCompressedFile, SizeOf(PHeader^.Header0));
  if prBuffIn.NoError then begin
    {$IfNDef Delphi}
    if PHeader^.Header0.Signature=cFileSignature then begin
    {$Else}
    if Equal(PHeader^.Header0.Signature,cFileSignature,SizeOf(PHeader^.Header0.Signature)) then begin
    {$EndIf}
      if (PHeader^.Header0.Size<=prBuffIn.FreeSize) then begin
	prBuffIn.ReadSize(prCompressedFile, PHeader^.Header0.Size);
	if prBuffIn.NoError then begin
	  VersionSet(PHeader^.Header0.Version);
	  if Version=cHeader.Version.MajorMinor then begin
	    PArcFile:=tPArcFile(@PHeader^.Data);
	    sz:=SizeOf(PArcFile^.Data)+PArcFile^.Name.Size;
	    if (sz<=PHeader^.Header0.Size)
	       {and (PArcFile^.Name.Size<=High(tArcFileNameLen))} then begin
	      Move(PArcFile^.Name,prOrgFileName,Succ(PArcFile^.Name.Size));
	      prOrgFileData:=PArcFile^.Data;
	    end else begin
	      ErrorSet(e_Invalid_Compressed_File_Header);
	    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_Too_Small_Buffer_to_Read_Compressed_File_Header);
      end;
    end else begin
      ErrorSet(e_Invalid_Compressed_File_Header);
    end;
  end else begin
    ErrorSet(e_Cant_Read_Compressed_File_Header);
  end;
end;

procedure tHuffman.WriteCompressedFileBuffer;
begin
  prBuffOut.Write(prCompressedFile);
  if prBuffOut.Error then begin
    ErrorSet(e_Cant_Write_Compressed_Buffer);
  end;
end;

function tHuffman.ReadOriginalFileBuffer;
begin
  prBuffIn.ReadWithReserve(prOriginalFile, SizeOf(tEncodedBufferHeader32));
  if prBuffIn.Error then begin
    ErrorSet(e_Cant_Read_Original_Buffer);
  end;
  ReadOriginalFileBuffer:=prBuffIn.DataSize;
end;


function tHuffman.ReadCompressedFileBuffer;
  var PCompressedBlock:tPCompressedFileBlock;
begin
  ReadCompressedFileBuffer:=0;
  prBuffIn.DataSizeSet(0);
  if Eof(prCompressedFile) then
    Exit;
  PCompressedBlock:=tPCompressedFileBlock(prBuffIn.PBuffChecked);
  prBuffIn.ReadSize(prCompressedFile,SizeOf(PCompressedBlock^.Header));
  if prBuffIn.NoError then begin
    if (PCompressedBlock^.Header.Size<=prBuffIn.FreeSize)
       {$IfNDef Delphi}and (PCompressedBlock^.Header.Size>0){$EndIf} then begin
      ReadCompressedFileBuffer:=prBuffIn.ReadSize(prCompressedFile,PCompressedBlock^.Header.Size);
      if prBuffIn.Error then begin
	ErrorSet(e_Cant_Read_Compressed_Buffer);
      end;
    end else begin
      ErrorSet(e_Too_Small_Buffer_To_Read_Compressed_Buffer);
    end;
  end else begin
    ErrorSet(e_Cant_Read_Compressed_Buffer);
  end;
end;

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

function tHuffman.CompressBuffer;
  var csz,SizeToCompress:tBufferIndex; Encoded:boolean;
    PCompressedBlock:tPCompressedFileBlock;
begin
  SizeToCompress:=prBuffIn.DataSize;
  if (SizeToCompress>0) then begin
    PCompressedBlock:=tPCompressedFileBlock(prBuffOut.PBuffChecked);
    EncodeBuf(prBuffIn.PBuff^,SizeToCompress,
	      PCompressedBlock^.Data, csz, Encoded);
    with PCompressedBlock^.Header do begin
      Size:=csz;
      if Encoded then begin
{	if tPEncodedBuffer(@PCompressedBlock^.Data).BType=f16bitHeader then
	   Header0.Flags:=[fCompressed, fHeader16]
	else
	   Header0.Flags:=[fCompressed, fHeader32];}
	Header0.Flags:=[fCompressed];
      end else begin
	Header0.Flags:=[];
      end;
      Header0.CRC:=0;
    end;
    Inc(csz,SizeOf(tCompressedFileBlockHeader));
  end else begin
    csz:=0;
  end;
  prBuffOut.DataSizeSet(csz);
  prBuffIn.DataSizeSet(0);
  CompressBuffer:=csz;
end;

function tHuffman.CompressBufferOptimal;
  var csz:tBufferIndex; Encoded:boolean;
    PCompressedBlock:tPCompressedFileBlock;
    RestSize,SizeToCompress:tBufferIndex;
begin
  SizeToCompress:=prBuffIn.DataSize;
  if (SizeToCompress>0) then begin
    PCompressedBlock:=tPCompressedFileBlock(prBuffOut.PBuffChecked);
    EncodeBufOptimal(prBuffIn.PBuff^,SizeToCompress,RestSize,
	      PCompressedBlock^.Data, csz, Encoded);
    prBuffIn.DataSizeSet(RestSize);
    with PCompressedBlock^.Header do begin
      Size:=csz;
      if Encoded then begin
	Header0.Flags:=[fCompressed];
      end else begin
	Header0.Flags:=[];
      end;
      Header0.CRC:=0;
    end;
    Inc(csz,SizeOf(tCompressedFileBlockHeader));
    prBuffOut.DataSizeSet(csz);
    CompressBufferOptimal:=csz;
  end else begin
    CompressBufferOptimal:=0;
  end;
end;

function tHuffman.DecompressBuffer;
  var
    sz:tBufferIndex;
    PCompressedBlock:tPCompressedFileBlock;
begin
  PCompressedBlock:=tPCompressedFileBlock(prBuffIn.PBuffChecked);
  if fCompressed in PCompressedBlock^.Header.Header0.Flags then begin
    DecodeBuf(PCompressedBlock^.Data, prBuffOut.PBuffChecked^, sz);
  end else begin
    sz:=PCompressedBlock^.Header.Size;
    Move(PCompressedBlock^.Data, prBuffOut.PBuffChecked^, sz);
  end;
  prBuffIn.DataShiftToBegin(PCompressedBlock^.Header.Size+SizeOf(PCompressedBlock^.Header));
  prBuffOut.DataSizeSet(sz);
  DecompressBuffer:=sz;
end;

procedure tHuffman.CompressBufferAndWrite;
begin
  CompressBuffer;
  WriteCompressedFileBuffer;
end;

procedure tHuffman.CompressBufferAndWriteOptimal;
begin
  CompressBufferOptimal;
  WriteCompressedFileBuffer;
end;

procedure tHuffman.DecompressBufferAndWrite;
begin
  DecompressBuffer;
  WriteOriginalFileBuffer;
end;

procedure tHuffman.CompressFile;
begin
  ErrorSet(e_OK);
  while NoError and (ReadOriginalFileBuffer>0) do begin
    CompressBufferAndWrite;
  end;
end;

procedure tHuffman.CompressFileOptimal;
begin
  ErrorSet(e_OK);
  while NoError and (ReadOriginalFileBuffer>0) do begin
    CompressBufferAndWriteOptimal;
  end;
end;

procedure tHuffman.DecompressFile;
begin
  ErrorSet(e_OK);
  while NoError and (ReadCompressedFileBuffer>0) do begin
    DecompressBufferAndWrite;
  end;
end;

procedure tHuffman.Stop;
begin
  CloseOriginalFile;
  CloseCompressedFile;
end;

procedure tHuffman.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;
      CompressFile;
    end;
    Stop;
  end;
end;

procedure tHuffman.EncodeFileOptimal;
begin
  InitDefault;
  if CheckBuffers then begin
    ErrorSet(e_OK);
    OpenOriginalFileToRead(FileName);
    if Error then Exit;
    OpenCompressedFileToWrite(PackedFileName);
    if NoError then begin
      StoreOriginalFileName(FileName);
      WriteCompressedFileHeader;
      CompressFileOptimal;
    end;
    Stop;
  end;
end;

procedure tHuffman.DecodeFile;
begin
  InitDefault;
  if CheckBuffers then begin
    ErrorSet(e_OK);
    OpenOriginalFileToWrite(FileName);
    if Error then Exit;
    OpenCompressedFileToRead(PackedFileName);
    if NoError then begin
      DecompressFile;
    end;
    Stop;
  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 tHuffman.DecodeFileToOriginal;
begin
  InitDefault;
  if CheckBuffers then begin
    ErrorSet(e_OK);
    OpenCompressedFileToRead(FileName);
    if Error then Exit;
    OpenOriginalFileToWrite(GetDir(FileName)+OriginalFileName);
    if NoError then begin
      DecompressFile;
    end;
    Stop;
  end;
end;

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

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

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

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

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

procedure tHuffman.VersionMajorSet;
begin
  prVersion.Major:=v;
end;

procedure tHuffman.VersionMinorSet;
begin
  prVersion.Minor:=v;
end;

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

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

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

function tFBuffer.Size;
begin
  if (prBufSize=not prNotBufSize) then begin
    Size:=prBufSize;
  end else begin
    Size:=0;
  end;
end;

function  tFBuffer.DataSize:tBufferIndex;
begin
  if (Size>0) then begin
    DataSize:=prDataSize;
  end else begin
    DataSize:=0;
  end;
end;

function  tFBuffer.FreeSize:tBufferIndex;
begin
  FreeSize:=Size-DataSize;
end;

procedure tFBuffer.DataSizeSet(sz:tBufferIndex);
begin
  if (sz<=Size) then begin
    prDataSize:=sz;
  end else begin
    prDataSize:=Size;
  end;
end;

procedure tFBuffer.DataSizeInc(sz:tBufferIndex);
begin
  DataSizeSet(DataSize+sz);
end;

function tFBuffer.PBuff;
begin
  if (Size>0) then begin
    PBuff:=prBuff;
  end else begin
    PBuff:=NIL;
  end;
end;

function  tFBuffer.PBuffChecked:tPBuffer;
begin
  if (Size>0) then begin
    PBuffChecked:=prBuff;
  end else begin
    PBuffChecked:=nil;
    RunError(204);
  end;
end;

function  tFBuffer.PCompressedBlockData;
begin
  PCompressedBlockData:=@tPCompressedFileBlock(PBuffChecked)^.Data;
end;

function  tFBuffer.PCompressedBlockHeader;
begin
  PCompressedBlockHeader:=@tPCompressedFileBlock(PBuffChecked)^.Header;
end;

procedure tFBuffer.DataShiftToBegin(sz:tBufferIndex);
  var dsz:tBufferIndex;
begin
  dsz:=DataSize;
  if (dsz>sz) then begin
    Dec(dsz,sz);
    System.Move(prBuff^[sz],prBuff^,dsz);
  end else begin
    dsz:=0;
  end;
  DataSizeSet(dsz);
end;

procedure tFBuffer.DeAllocate;
begin
  if (Size>0) then begin
    FreeMem(prBuff,prBufSize);
  end;
  prBuff:=NIL;
  DataSizeSet(0);
  prBufSize:=0;
  prNotBufSize:=(not prBufSize) and High(prBufSize);
end;

function HeapErrorFunc(Size:word):integer; far;
begin
  HeapErrorFunc:=1;
end;

procedure tFBuffer.Allocate;
  {$IfNDef Delphi}
    var OldHeapErr:pointer;
  {$EndIf}
begin
  Deallocate;
  if SizeToAllocate>0 then begin;
    if SizeToAllocate<cMinBufSize then SizeToAllocate:=cMinBufSize;
    {$IfNDef Delphi}
    OldHeapErr:=HeapError;
    HeapError:=@HeapErrorFunc;
    GetMem(prBuff,SizeToAllocate);
    HeapError:=OldHeapErr;
    {$Else}
    try
      GetMem(prBuff,SizeToAllocate);
    except
      prBuff:=NIL;
    end;
    {$EndIf}
    if prBuff<>NIL then begin
      prBufSize:=SizeToAllocate;
      prNotBufSize:=not prBufSize;
      DataSizeSet(0);
      SetLastError(ebOk);
    end else begin
      SetLastError(ebAllocateFail);
    end;
  end;
end;

function  tFBuffer.LastError:tBufError;
begin
  LastError:=prLastError;
end;

function  tFBuffer.NoError:boolean;
begin
  NoError:=prLastError=ebOK;
end;

function  tFBuffer.Error:boolean;
begin
  Error:=prLastError<>ebOK;
end;

function  tFBuffer.SetLastError(ErrCode:tBufError):tBufError;
begin
  SetLastError:=prLastError;
  prLastError:=ErrCode;
end;

function  tFBuffer.Write;
  var sz:tBufferIndex;
begin
  sz:=0;
  if DataSize>0 then begin
    BlockWrite(Fl, PBuff^,  DataSize, sz);
    if (sz=DataSize) then SetLastError(ebOK) else SetLastError(ebWriteFail);
  end else if DataSize=0 then begin
    SetLastError(ebOK)
  end else begin
    SetLastError(ebWriteFail);
  end;
  Write:=sz;
end;

function tFBuffer.ReadEx(var fl:File; SizeToRead:tBufferIndex):tBufferIndex;
  var sz:tBufferIndex;
begin
  if SizeToRead>FreeSize then begin
    SizeToRead:=FreeSize;
  end;
  BlockRead(Fl, PBuff^[DataSize],  SizeToRead, sz);
  DataSizeSet(DataSize+sz);
  if (sz<SizeToRead) and (not Eof(Fl)) then begin
    SetLastError(ebReadFail);
  end else begin
    SetLastError(ebOk);
  end;
  ReadEx:=sz;
end;

function tFBuffer.ReadSize(var fl:File; SizeToRead:tBufferIndex):tBufferIndex;
  var sz:tBufferIndex;
begin
  if SizeToRead<=FreeSize then begin
    sz:=ReadEx(fl,SizeToRead);
    if sz<>SizeToRead then
      SetLastError(ebReadFail);
    ReadSize:=sz;
  end else begin
    SetLastError(ebTooSmallFreeSize);
    ReadSize:=0;
  end;
end;

function  tFBuffer.Read(var fl:File):tBufferIndex;
begin
  Read:=ReadEx(fl,FreeSize);
end;

function  tFBuffer.ReadWithReserve(var fl:File; ReservedSize:tBufferIndex):tBufferIndex;
begin
  ReadWithReserve:=ReadEx(fl,FreeSize-ReservedSize);
end;

END.