rsvk/Component/BitStreamUnit.pas

unit BitStreamUnit;
{-------------------------------------------------------------------------------
Bit Access for Streams
----------------------
revision 1.0

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

Desc:
  Acts as a Bit access interface and buffer for a TStream.
  Any Stream (TMemoryStream, TFileStream) can be assigned.
  

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) after which data corruption
  has most likely occured.
  Set to MaxLongInt if the limit is not to be used (default).



version
  1.0: First release
-------------------------------------------------------------------------------}

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

const
  NUM_FAKED_BYTES = 20;

type

  TBitStream = class
  private
    Stream: TStream;

    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);
    procedure GetNextByte(var b: byte);
    procedure WriteByte(b: byte);

  public
    constructor Create(_Stream: TStream; IsRead: boolean);
    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 TBitStream.Create(_Stream: TStream; IsRead: boolean);
begin
  inherited Create;
  IsOpenInput := IsRead;

  rack := 0;
  mask := $80;
  SetReadByteLimit(MaxLongInt);
  Stream := _Stream;
end;

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

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

procedure TBitStream.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
    GetNextByte(b);
    inc(bytes_read);
  end;
end;

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

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

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

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



procedure TBitStream.OutputBit(bit: byte);
begin
  if (bit <> 0) then
    rack := rack or mask;

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

procedure TBitStream.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 TBitStream.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 TBitStream.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;



procedure TBitStream.GetNextByte(var b: byte);
begin
  {Interface to Stream}
  Stream.ReadBuffer(b, 1);
end;

procedure TBitStream.WriteByte(b: byte);
begin
  Stream.WriteBuffer(b, 1);
end;

end.