classlib.pas

HUFFMAN SUANFA SHI YONG JAVA BIAB DE

unit ClassLib;

interface
    uses  SysUtils;
    const BufFileHeaderStr: ShortString = ' Buffer file ';
          BufFileHeaderLen: byte = 13;
    type
         Indexes  = integer;

         EInvalidBufferReSizing = class(Exception);
         EInvalidBufferFile     = class(Exception);

         TBuffer = class(TObject)
         private
                  ptrBuf   : pointer;
                  fBufSize : integer;
         protected
                  procedure  SetBufSize(Size: integer);
                  procedure  LoadBuffer(var F: file); virtual;
                  procedure  SaveBuffer(var F: file); virtual;
         public
                  constructor Create;
                  destructor  Destroy; override;
                  procedure   LoadFromFile(filename: string);
                  procedure   SaveToFile(filename: string);
                  procedure   MakeCopyOf(Source: TBuffer); virtual;
                  property    BufferSize: integer read fBufSize write SetBufSize;
                  property    Buffer: pointer read ptrBuf;
         end;

         TRecordCompareFunc = function(var Rec1,Rec2): integer;
         {-1 when Rec1<Rec2; 0 when Rec1=Rec2 and +1 when Rec1>Rec2}
         TRecordUpdateProc  = procedure(var Rec);

         TRecordBuffer = class (TBuffer)
         protected
                  fAmount   : Indexes;
                  RecordSize: Cardinal;
                  procedure   LoadBuffer(var F: file); override;
                  procedure   SaveBuffer(var F: file); override;
                  procedure   SetAmount(NewAmount: Indexes);
         public
                  constructor Create;
                  constructor Init(RecSize: Cardinal);
                  procedure   GetRecord(I: Indexes; var Rec);
                  procedure   SetRecord(I: Indexes; var Rec);
                  function    FindRecord(var Rec): Indexes;
                  function    SpecialFind(Compare: TRecordCompareFunc;var Rec): Indexes;
                  procedure   MakeCopyOf(Source: TBuffer); override;
                  procedure   ForAllDo(Update: TRecordUpdateProc);
                  function    Add(var Rec): Indexes; virtual;
                  procedure   Del(const i: Indexes); virtual;
                  procedure   Reduce;
                  property    Amount: Indexes read fAmount write SetAmount;
         end;

         function IsEqual(var Source, Dest; Size: Integer): Boolean;
         function max(a,b: integer): integer;
         function min(a,b: integer): integer;
implementation

function IsEqual(var Source, Dest; Size: Integer): Boolean;
  type
      TBytes = array[0..MaxInt - 1] of Byte;
  var
     N: Integer;
begin
     N := 0;
     while (N < Size) and (TBytes(Dest)[N] = TBytes(Source)[N]) do
           Inc(N);
     IsEqual := N = Size;
end;

function min(a,b: integer): integer;
begin
     if a>=b then min := b
             else min := a
end;

function max(a,b: integer): integer;
begin
     if a>=b then max := a
             else max := b
end;

{..............................TBuffer.........................................}

constructor TBuffer.Create;
begin
     inherited;
     ptrBuf := nil;
     fBufSize := 0
end;

destructor  TBuffer.Destroy;
begin
     if ptrBuf<>nil then FreeMem(ptrBuf,fBufSize);
     inherited
end;

procedure TBuffer.MakeCopyOf(Source: TBuffer);
begin
     if ptrBuf<>nil
     then begin
          FreeMem(ptrBuf,fBufSize);
          ptrBuf   := nil;
          fBufSize := 0
     end;
     SetBufSize(Source.fBufSize);
     move(Source.ptrBuf^,ptrBuf^,fBufSize)
end;

procedure TBuffer.LoadBuffer(var F: file);
  var Size,NumRead: integer;
                 S: ShortString;
begin
     S[0] := char(BufFileHeaderLen);
     BlockRead(F, S[1], BufFileHeaderLen, NumRead);
     if (NumRead<>BufFileHeaderLen) or (S<>BufFileHeaderStr)
     then raise EInvalidBufferFile.Create('Invalid buffer file header');
     BlockRead(F, Size, SizeOf(Size), NumRead);
     if (NumRead<>SizeOf(Size)) or (Size<0)
     then raise EInvalidBufferFile.Create('Invalid buffer file header');
     BufferSize := Size;
     if Size>0 then
     begin
          BlockRead(F, ptrBuf^, Size, NumRead);
          if NumRead<>Size
          then raise EInvalidBufferFile.Create('Invalid buffer file lenght')
     end
end;

procedure TBuffer.SaveBuffer(var F: file);
begin
     BlockWrite(F, BufFileHeaderStr[1], BufFileHeaderLen);
     BlockWrite(F, fBufSize, SizeOf(fBufSize));
     if fBufSize>0 then BlockWrite(F, ptrBuf^, fBufSize)
end;
{$O-}
procedure TBuffer.LoadFromFile(filename: string);
  var F: file;
begin
     AssignFile(F,FileName);
     try
        Reset(F, 1);
        LoadBuffer(F);
     finally
        CloseFile(F);
     end;
end;

procedure TBuffer.SaveToFile(filename: string);
  var f: file;
begin
     AssignFile(F,FileName);
     try
        ReWrite(F, 1);
        SaveBuffer(F);
     finally
        CloseFile(F);
     end;
end;
{$O+}
procedure  TBuffer.SetBufSize(Size: integer);
  var ptrTemp: pointer;
begin
     if (Size>=0) and (Size<>fBufSize) then
     begin
          if Size = 0 then
          begin
               if ptrBuf<>nil then FreeMem(ptrBuf,fBufSize);
               ptrBuf := nil;
               fBufSize := Size
          end
          else begin
               ptrTemp := ptrBuf;
               try
                     GetMem(ptrBuf,Size);
               except
                     ptrBuf := ptrTemp;
                     raise EInvalidBufferReSizing.Create('Buffer hasn''t resised')
               end;
               move(ptrTemp^,ptrBuf^,min(fBufSize,Size));
               if ptrTemp<>nil then FreeMem(ptrTemp,fBufSize);
               fBufSize := Size
          end
     end
end;

{...............................TRecordBuffer..................................}

constructor TRecordBuffer.Create;
begin
     inherited;
     fAmount := 0;
     RecordSize := 0
end;

constructor TRecordBuffer.Init(RecSize: Cardinal);
begin
     Create;
     RecordSize := RecSize
end;

function TRecordBuffer.FindRecord(var Rec): Indexes;
  var Flag: Boolean;
         i: Indexes;
         R: pointer;
begin
     i := 0;
     Flag := false;
     GetMem(R,RecordSize);
     while (i<Amount) and (not Flag) do
     begin
          GetRecord(i,R^);
          if IsEqual(Rec,R,RecordSize)
          then Flag := True
          else inc(i)
     end;
     if Flag
     then Result := i
     else Result := -1;
     FreeMem(R,RecordSize)
end;

function TRecordBuffer.SpecialFind(Compare: TRecordCompareFunc;var Rec): Indexes;
  var Flag: Boolean;
         i: Indexes;
         R: pointer;
begin
     i := 0;
     Flag := false;
     GetMem(R,RecordSize);
     while (i<Amount) and (not Flag) do
     begin
          GetRecord(i,R^);
          if Compare(Rec,R^)=0
          then Flag := True
          else inc(i)
     end;
     if Flag
     then Result := i
     else Result := -1;
     FreeMem(R,RecordSize)
end;

procedure TRecordBuffer.ForAllDo(Update: TRecordUpdateProc);
  var R: pointer;
      i: Indexes;
begin
     GetMem(R,RecordSize);
     for i := 0 to fAmount-1 do
     begin
          GetRecord(i,R^);
          Update(R^);
          SetRecord(i,R^)
     end;
     FreeMem(R,RecordSize)
end;

procedure TRecordBuffer.MakeCopyOf(Source: TBuffer);
begin
     inherited;
     if Source is TRecordBuffer
     then begin
          RecordSize := (Source as TRecordBuffer).RecordSize;
          fAmount    := (Source as TRecordBuffer).fAmount;
     end
     else raise EConvertError.Create('Operand is not of TRecordBuffer type')
end;

procedure TRecordBuffer.LoadBuffer(var F: file);
  var NumRead: integer;
begin
     inherited;
     BlockRead(F, fAmount, SizeOf(fAmount), NumRead);
     if NumRead<>SizeOf(fAmount)
     then raise EInvalidBufferFile.Create('Invalid buffer file lenght')
end;

procedure TRecordBuffer.SaveBuffer(var F: file);
begin
     inherited;
     BlockWrite(F, fAmount, SizeOf(fAmount))
end;

procedure TRecordBuffer.GetRecord(I: Indexes; var Rec);
begin
     if (I<0) or (I>=fAmount)
     then raise ERangeError.Create('Index of record is out of range');
     move(Pointer(Cardinal(Buffer) + I*RecordSize)^,Rec,RecordSize)
end;

procedure TRecordBuffer.SetRecord(I: Indexes; var Rec);
begin
     if (I<0) or (I>=fAmount)
     then raise ERangeError.Create('Index of record is out of range');
     move(Rec,Pointer(Cardinal(Buffer) + I*RecordSize)^,RecordSize)
end;

procedure TRecordBuffer.SetAmount(NewAmount: Indexes);
begin
     if NewAmount<0 then raise ERangeError.Create('Invalid amount of records');
     if NewAmount*RecordSize>BufferSize
     then BufferSize := NewAmount*RecordSize;
     fAmount := NewAmount
end;

procedure TRecordBuffer.Reduce;
begin
     if Amount*RecordSize<BufferSize
     then BufferSize := Amount*RecordSize
end;

function TRecordBuffer.Add(var Rec): Indexes;
begin
     SetAmount(fAmount+1);
     SetRecord(fAmount-1,Rec);
     Result := fAmount-1
end;

procedure TRecordBuffer.Del(const i: Indexes);
begin
     move(Pointer(Cardinal(Buffer)+(i+1)*RecordSize)^,
          Pointer(Cardinal(Buffer)+i*RecordSize)^,
          RecordSize*(fAmount-i-1));
     SetAmount(fAmount-1)
end;

end.