rsvk/Component/bit_file_unit.pas

unit bit_file_unit;
{-------------------------------------------------------------------------------
Bit Access for Files
--------------------
revision 1.3

reSource v2.6
Copyright (C) 1998-2001 Victor Kasenda / gruv
http://go.to/gruv
email: vickas@singnet.com.sg




Usage Note:
  Call BeginBitAccess and EndBitAccess to start and end bit access.
  Failure to call any of which may lead to data corruption.

Specially tailored procedures:

  SetReadByteLimit
  This checks that the bits read fall within the limit. It allows a maximum
  of NUM_FAKED_BYTES bytes more read (which the decoder uses) afther which data corruption
  has most likely occured.
  Set to MaxLongInt if the limit is not to be used (default).



version
       1.1: Added SetReadByteLimit
       1.2: Added BeginBitAccess and EndBitAccess
       1.3: Fixed read_byte_limit. off by one.
-------------------------------------------------------------------------------}

(**) interface (**)
uses smart_buf_filestream_unit, SysUtils;

const
  NUM_FAKED_BYTES = 20;

type

  TBitFile = class(TBufferedFileStream)
  private

    mask: byte;
    rack: byte;

    IsOpenInput: boolean;

    read_byte_limit: integer;
    bytes_read: integer;
    //extra_bytes_read: integer;    // bytes read past the limit

    procedure BitGetNextByte(var b: byte);

  public
    constructor Create(const FileName: string; Mode: Word);
    destructor Destroy; override;

    procedure SetReadByteLimit(const limit: integer);

    procedure BeginBitReadAccess;
    procedure EndBitReadAccess;
    procedure BeginBitWriteAccess;
    procedure EndBitWriteAccess;

    procedure OutputBit(bit: byte);
    procedure OutputBits(code: longint; count: byte);
    function  InputBit: byte;
    function  InputBits( count: byte ): longint;

  end;

(**) implementation (**)
uses ErrorUnit;

constructor TBitFile.Create(const FileName: string; Mode: Word);
begin
  inherited Create(FileName, Mode, 64*1024);

  IsOpenInput := (Mode = fmOpenRead);
  rack := 0;
  mask := $80;
  SetReadByteLimit(MaxLongInt);
end;

destructor TBitFile.Destroy;
begin
  if (not IsOpenInput) and (Mask <> $80) then WriteByte(rack);
  inherited Destroy;
end;

procedure TBitFile.SetReadByteLimit(const limit: integer);
begin
  bytes_read := 0;
  read_byte_limit := limit;
  //extra_bytes_read := 0;
end;

procedure TBitFile.BitGetNextByte(var b: byte);
begin
  if (bytes_read >= read_byte_limit) then    {If limit number of bytes already read}
  begin

    if (bytes_read - read_byte_limit >= NUM_FAKED_BYTES) then
    begin
      ShowError('Too many bytes read in bit mode.');
      halt(1);
    end
    else
    begin
      b := 0;
      inc(bytes_read);
    end;

  end
  else
  begin
    inherited GetNextByte(b);
    inc(bytes_read);
  end;
end;

procedure TBitFile.BeginBitReadAccess;
begin
  mask := $80;
  rack := 0;
end;

procedure TBitFile.EndBitReadAccess;
begin
  mask := $80;
  rack := 0;
end;

procedure TBitFile.BeginBitWriteAccess;
begin
  mask := $80;
  rack := 0;
end;

procedure TBitFile.EndBitWriteAccess;
begin
  if (not IsOpenInput) and (Mask <> $80) then
  begin
    WriteByte(rack);
  end;
  Mask := $80;
  rack := 0;
end;



procedure TBitFile.OutputBit(bit: byte);
begin
  if (bit <> 0) then
    rack := rack or mask;
  {if bit = 1 then
    rack := rack or mask;}

  mask := mask shr 1;
  if mask = 0 then
  begin
    WriteByte(rack);
    rack := 0;
    mask := $80;
  end;
end;

procedure TBitFile.OutputBits(code: longint; count: byte);
var
  TempMask: longint;
begin
  TempMask := 1 Shl (Count-1);
  while TempMask <> 0 do
  begin
    if (TempMask and Code <> 0) then
      Rack := Rack or Mask;

    Mask := Mask shr 1;
    if Mask = 0 then
    begin
      WriteByte(Rack);
      Rack := 0;
      Mask := $80;
    end;

    TempMask := TempMask shr 1;
  end;
end;

function TBitFile.InputBit: byte;
var
  value: byte;
begin
  if (mask = $80) then
    BitGetNextByte(rack);

  value := Rack and Mask;
  Mask := Mask shr 1;
  if Mask = 0 then Mask := $80;

  if value = 0 then
    result := 0
  else
    result := 1;
end;

function TBitFile.InputBits( count: byte ): longint;
var
  TempMask: longint;
  value: longint;
begin
  TempMask := 1 shl (count-1);
  value := 0;

  while TempMask <> 0 do
  begin
    if (Mask = $80) then
      BitGetNextByte(Rack);

    if (Rack and Mask <> 0) then
      value := (value or TempMask);

    TempMask := TempMask shr 1;

    Mask := Mask shr 1;
    if Mask = 0 then Mask := $80;
  end;

  result := value;
end;



end.