{ Буфер для файла }
{---------------------------------------------------------------------------
(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 FileBuf;
{$X+}

INTERFACE
  uses ComTypes;


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

type

  { Ошибки буфера }
  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  PFreeBuff:tPBuffer;
      function  PFreeBuffChecked:tPBuffer;
      function  Size:tBufferIndex;
      function  DataSize:tBufferIndex;
      function  FreeSize:tBufferIndex;
      function  Empty:boolean;
      procedure DataSizeSet(sz:tBufferIndex);
      procedure DataSizeInc(sz:tBufferIndex);
      procedure DataShiftToBegin(sz:tBufferIndex);
      procedure Clear;
      function  Write(var fl:File):tBufferIndex;
      function  ReadEx(var fl:File; SizeToRead:tBufferIndex):tBufferIndex;
      function  Read(var fl:File):tBufferIndex;
      function  ReadSize(var fl:File; SizeToRead:tBufferIndex):tBufferIndex;
  end;


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

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.PFreeBuff:tPBuffer;
begin
  if (FreeSize>0) then begin
    PFreeBuff:=Addr(prBuff^[prDataSize]);
  end else begin
    PFreeBuff:=NIL;
  end;
end;

function tFBuffer.PFreeBuffChecked:tPBuffer;
begin
  if (FreeSize>0) then begin
    PFreeBuffChecked:=Addr(prBuff^[prDataSize]);
  end else begin
    PFreeBuffChecked:=NIL;
    RunError(204);
  end;
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;

procedure tFBuffer.Clear;
begin
  prDataSize:=0;
end;

function  tFBuffer.Empty:boolean;
begin
  Empty:=(prDataSize=0);
end;

END.