{---------------------------------------------------------------------------
(c) Copyright	 Aleksandrov O.E., 2010

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

----------------------------------------------------------------------------}
Unit AriFile;
{$X+}

INTERFACE
  uses Windows
       , VeryLongArithmetic
       , FileBuf, AriTypes, AriCodec;

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

  { Сигнатура(заголовок) упакованного файла }
  cFileSignature='AR compressed. v1.0 '+
		 '(c) Aleksandrov O.E., 2010'+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; { версия  }
    LongArithmeticDigitsCount:byte; { разрядность длинной арифметики, используемая методом }
  end;
  tPArchiveHeader=^tArchiveHeader;

  tFileName=shortstring;

  { Запись для имени исходного файла }
  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); { временное значение для контрольной суммы }

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_LongArithmeticDigitsCount,
    e_Invalid_TreeRebuildCount,
    e_No_Memory_For_Dictionary,
    e_Compressed_FileTail_Too_Large,
    e_Compressed_File_Invalid_CRC,
    e_Compressed_FileTail_ErrorRead
  );

  tFileNameStr=string;

  { Кодек для файла. Арифметическое кодирование. Статический вариант.}
  tAriFile=object(tAriCodec)
    private
      prFlags:tFlags;
      prBuffIn,prBuffOut:tFBuffer;
      prOriginalFile,prCompressedFile:file;
      prOrgFileData:tArcFileData;
      prFileSize:cardinal;
      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, SysUtils,
    uMiscFun;

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

function  tAriFile.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_LongArithmeticDigitsCount:
      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 tAriFile.ErrorSet(e:tError);
begin
  if e=e_OK then
    prErr:=e
  else if prErr=e_OK then
    prErr:=e;
end;

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

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

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

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

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

constructor tAriFile.Init;
begin
  prBuffIn.Allocate((aBufferSize div SizeOf(tSymbol))*SizeOf(tSymbol));
  prBuffIn.EmptySizeSet(SizeOf(tSymbol)-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 tAriFile.InitDefault;
begin
  if (BufferSize=0) then begin
    Init(cDefaultBufSize);
  end;
end;

procedure tAriFile.StoreOriginalFileName;
begin
  prOrgFileName:=ExtractFileName(FileName);
end;

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

{$IfOpt I+} {$Define IisON} {$I-} {$EndIf}
function GetFileTimeAndAttributes(const FileName:string; var FileData:tArcFileData):integer;
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;

procedure tAriFile.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);
end;

procedure tAriFile.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);
    WriteArchiveHeader;
  end;
end;

procedure tAriFile.OpenOriginalFileToWrite;
begin
  ErrorSet(e_OK);
   prOrgFullFileName:=ExpandUNCFileName(FileName);
   Assign(prOriginalFile,prOrgFullFileName);
  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);
  end;
end;

procedure tAriFile.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);
    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;
  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;

function tAriFile.CloseOriginalFile;
  var ior:integer;
begin
  Close(prOriginalFile);
  ior:=IOResult;
  if (ior=0) and Flag(fOrgFileOpenedForWrite) then begin
    SetFileTimeAndAttributes(prOrgFullFileName,prOrgFileData);
  end;
  FlagClear(fOrgFileOpenedForWrite);
  CloseOriginalFile:=ior;
end;

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

{ Запись заголовка архива  }
procedure tAriFile.WriteArchiveHeader;
  var
    PHeader:tPArchiveHeader;
begin
  PHeader:=tPArchiveHeader(prBuffOut.PBuffChecked);
  PHeader^:=cHeader;
  PHeader^.LongArithmeticDigitsCount:=cMaxDigitsCount;
  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 tAriFile.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 tAriFile.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
      if Equal(PHeader^.Signature,cFileSignature,SizeOf(PHeader^.Signature)) then begin
	VersionSet(PHeader^.Version);
	if Version=cHeader.Version.MajorMinor then begin
	  if (PHeader^.LongArithmeticDigitsCount<>cMaxDigitsCount) then begin
	    ErrorSet(e_Invalid_LongArithmeticDigitsCount);
	  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 tAriFile.ReadCompressedFileHeader;
  var
    PHeader:tPFileHeader;
    sz:word; 
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;

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

function tAriFile.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;

function tAriFile.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;
end;

procedure tAriFile.WriteCompressedFileTail;
  var
    PTail:tPFileTail;
    sz:word;
begin
  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 tAriFile.ReadCompressedFileTail;
  var
    PTail:tPFileTail;
    sz:word;
begin
  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 tAriFile.WriteOriginalFileBuffer;
begin
  prBuffOut.Write(prOriginalFile);
  if prBuffOut.Error then begin
    ErrorSet(e_Cant_Write_Original_Buffer);
  end;
end;

function tAriFile.CompressBuffer;
  var EncodedSize:tBufferIndex;
      EncodedDataSize:tByteBufferIndex;
begin
  { Є®¤Ёа®ў ­ЁҐ }
  Encode(prBuffIn.PBuffChecked^, prBuffIn.DataSize, EncodedSize,
		 prBuffOut.PFreeBuff^, prBuffOut.FreeSize, EncodedDataSize);
  { Ё§¬Ґ­Ґ­ЁҐ а §¬Ґа  ¤ ­­ле ў ЎгдҐа е }
  prBuffIn.DataShiftToBegin(EncodedSize); { г¤ «пҐ¬ § Є®¤Ёа®ў ­­го з бвм Ё§ BuffIn}
  prBuffOut.DataSizeInc(EncodedDataSize); { гбв ­ ў«Ёў Ґ¬ а §¬Ґа ¤ ­­ле ў Є®¤Ёа®ў ­­®¬ BuffOut}
  { ў®§ўа й Ґ¬ а §¬Ґа ¤ ­­ле ў Є®¤Ёа®ў ­­®¬ ЎгдҐаҐ }
  CompressBuffer:=EncodedDataSize;
end;

function tAriFile.DecompressBuffer;
  var
    DecodedSize:tByteBufferIndex;
    OutSize,DecodedDataSize:tBufferIndex;
begin
  { ‚лзЁб«пҐ¬ ®бв ўиЁ©бп ¤«п ¤ҐЄ®¬ЇаҐббЁЁ а §¬Ґа д ©«  }
  OutSize:=prBuffOut.Size;
  if OutSize>prFileSize then begin
    OutSize:=(((prFileSize + Pred(SizeOf(tSymbol))) div SizeOf(tSymbol))*SizeOf(tSymbol) );
  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 tAriFile.CompressBufferAndWrite;
  var EncodedDataSize:tByteBufferIndex;
begin
  { Инициируем данные для кодирования и пишем заголовок кодированного буфера }
  StartEncodeBuffer(prBuffIn.PBuffChecked^, prBuffIn.DataSize,
		 prBuffOut.PBuffChecked^, prBuffOut.Size,   EncodedDataSize);
  { Помечаем как занятый размер под заголовок }
  prBuffOut.DataSizeSet(EncodedDataSize);
  { Сбрасываем заголовок в файл - пока непонятно как лучше...}
//  WriteCompressedFileBuffer;
//  prBuffOut.DataSizeSet(0);

  { кодируем данные }
  repeat
    CompressBuffer;
    WriteCompressedFileBuffer;
  until prBuffIn.Empty;

  { для записи конца кодирования порции нужно вызвать с пустым prBuffIn}
  CompressBuffer;
  WriteCompressedFileBuffer;
end;

procedure tAriFile.DecompressBufferAndWrite;
  var DecodedDataSize:tByteBufferIndex;
begin
  { Инициируем данные для кодирования и пишем заголовок кодированного буфера }
  if PortionDecoded then begin
    StartDecodeBuffer(prBuffIn.PBuffChecked^, prBuffIn.DataSize, DecodedDataSize);
    { Помечаем как занятый размер под заголовок }
    prBuffIn.DataShiftToBegin(DecodedDataSize);
  end;
  repeat
    DecodedDataSize:=DecompressBuffer;
    if DecodedDataSize>0 then
      WriteOriginalFileBuffer;
  until prBuffIn.Empty or (prFileSize=0) or PortionDecoded or (DecodedDataSize=0);
  if (prFileSize=0) and not PortionDecoded and (DecodedDataSize>0) then begin
    { обработка хвоста последней записи }
    DecompressBuffer;
  end;
end;

procedure tAriFile.CompressFile;
begin
  EncodeReset;
  while NoError and (ReadOriginalFileBuffer>0) do begin
    CompressBufferAndWrite;
  end;
//  if NoError then begin
//    CompressBufferAndWrite; { § ­®бЁ¬ ў д ©« ®бв вЄЁ ЎЁв }
//  end;
end;

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

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

procedure tAriFile.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 tAriFile.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 tAriFile.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  tAriFile.CheckBuffers:boolean;
begin
  if (BufferSize=0) then begin
    CheckBuffers:=FALSE;
    ErrorSet(e_No_Buffers_Allocated);
  end else begin
    CheckBuffers:=TRUE;
  end;
end;

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

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

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

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

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

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

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

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

END.